Released SD*5.3*535 SEQ #453 Extracted from mail message **KIDS**:SD*5.3*535^ **INSTALL NAME** SD*5.3*535 "BLD",7954,0) SD*5.3*535^SCHEDULING^0^3090123^y "BLD",7954,1,0) ^^6^6^3090114^ "BLD",7954,1,1,0) This patch contains fixes for the following issues: "BLD",7954,1,2,0) Computed date fields not printing the year when doing a Fileman inquiry "BLD",7954,1,3,0) Turn off option DPA Detailed Patient Assignments[SC PCMM DETAILED LIST "BLD",7954,1,4,0) PTS] "BLD",7954,1,5,0) Practitioners Patients report header issue "BLD",7954,1,6,0) Roll and scroll problem with PCMM enrollment "BLD",7954,4,0) ^9.64PA^404.57^1 "BLD",7954,4,404.57,0) 404.57 "BLD",7954,4,404.57,2,0) ^9.641^404.57^1 "BLD",7954,4,404.57,2,404.57,0) TEAM POSITION (File-top level) "BLD",7954,4,404.57,2,404.57,1,0) ^9.6411^303^3 "BLD",7954,4,404.57,2,404.57,1,301,0) CURRENT EFFECTIVE DATE "BLD",7954,4,404.57,2,404.57,1,302,0) CURRENT ACTIVATION DATE "BLD",7954,4,404.57,2,404.57,1,303,0) CURRENT INACTIVATION DATE "BLD",7954,4,404.57,222) y^n^p^^^^n^^n "BLD",7954,4,404.57,224) "BLD",7954,4,"APDD",404.57,404.57) "BLD",7954,4,"APDD",404.57,404.57,301) "BLD",7954,4,"APDD",404.57,404.57,302) "BLD",7954,4,"APDD",404.57,404.57,303) "BLD",7954,4,"B",404.57,404.57) "BLD",7954,6.3) 3 "BLD",7954,"KRN",0) ^9.67PA^779.2^20 "BLD",7954,"KRN",.4,0) .4 "BLD",7954,"KRN",.401,0) .401 "BLD",7954,"KRN",.402,0) .402 "BLD",7954,"KRN",.403,0) .403 "BLD",7954,"KRN",.5,0) .5 "BLD",7954,"KRN",.84,0) .84 "BLD",7954,"KRN",3.6,0) 3.6 "BLD",7954,"KRN",3.8,0) 3.8 "BLD",7954,"KRN",9.2,0) 9.2 "BLD",7954,"KRN",9.8,0) 9.8 "BLD",7954,"KRN",9.8,"NM",0) ^9.68A^2^2 "BLD",7954,"KRN",9.8,"NM",1,0) SCRPPAT3^^0^B32341023 "BLD",7954,"KRN",9.8,"NM",2,0) SCMCQK1^^0^B92256420 "BLD",7954,"KRN",9.8,"NM","B","SCMCQK1",2) "BLD",7954,"KRN",9.8,"NM","B","SCRPPAT3",1) "BLD",7954,"KRN",19,0) 19 "BLD",7954,"KRN",19,"NM",0) ^9.68A^1^1 "BLD",7954,"KRN",19,"NM",1,0) SC PCMM DETAIL LIST PTS^^0 "BLD",7954,"KRN",19,"NM","B","SC PCMM DETAIL LIST PTS",1) "BLD",7954,"KRN",19.1,0) 19.1 "BLD",7954,"KRN",101,0) 101 "BLD",7954,"KRN",409.61,0) 409.61 "BLD",7954,"KRN",771,0) 771 "BLD",7954,"KRN",779.2,0) 779.2 "BLD",7954,"KRN",870,0) 870 "BLD",7954,"KRN",8989.51,0) 8989.51 "BLD",7954,"KRN",8989.52,0) 8989.52 "BLD",7954,"KRN",8994,0) 8994 "BLD",7954,"KRN","B",.4,.4) "BLD",7954,"KRN","B",.401,.401) "BLD",7954,"KRN","B",.402,.402) "BLD",7954,"KRN","B",.403,.403) "BLD",7954,"KRN","B",.5,.5) "BLD",7954,"KRN","B",.84,.84) "BLD",7954,"KRN","B",3.6,3.6) "BLD",7954,"KRN","B",3.8,3.8) "BLD",7954,"KRN","B",9.2,9.2) "BLD",7954,"KRN","B",9.8,9.8) "BLD",7954,"KRN","B",19,19) "BLD",7954,"KRN","B",19.1,19.1) "BLD",7954,"KRN","B",101,101) "BLD",7954,"KRN","B",409.61,409.61) "BLD",7954,"KRN","B",771,771) "BLD",7954,"KRN","B",779.2,779.2) "BLD",7954,"KRN","B",870,870) "BLD",7954,"KRN","B",8989.51,8989.51) "BLD",7954,"KRN","B",8989.52,8989.52) "BLD",7954,"KRN","B",8994,8994) "BLD",7954,"QDEF") ^^^^^^^^^^YES "BLD",7954,"QUES",0) ^9.62^^ "BLD",7954,"REQB",0) ^9.611^2^2 "BLD",7954,"REQB",1,0) SD*5.3*524^1 "BLD",7954,"REQB",2,0) SD*5.3*520^1 "BLD",7954,"REQB","B","SD*5.3*520",2) "BLD",7954,"REQB","B","SD*5.3*524",1) "FIA",404.57) TEAM POSITION "FIA",404.57,0) ^SCTM(404.57, "FIA",404.57,0,0) 404.57IA "FIA",404.57,0,1) y^n^p^^^^n^^n "FIA",404.57,0,10) "FIA",404.57,0,11) "FIA",404.57,0,"RLRO") "FIA",404.57,0,"VR") 5.3^SD "FIA",404.57,404.57) 1 "FIA",404.57,404.57,301) "FIA",404.57,404.57,302) "FIA",404.57,404.57,303) "KRN",19,6353,-1) 0^1 "KRN",19,6353,0) SC PCMM DETAIL LIST PTS^Detailed Patient Assignments^Obsolete with SD*5.3*535^R^^^^^^^^SCHEDULING^^ "KRN",19,6353,1,0) ^19.06^6^6^3080421^^ "KRN",19,6353,1,1,0) This report lists patients and the clinics in which they are enrolled. "KRN",19,6353,1,2,0) This report may be used prior to team/position assignments in order to "KRN",19,6353,1,3,0) help validate clinic enrollments. The report can be printed for those "KRN",19,6353,1,4,0) patients who are assigned to the team for primary care or for those "KRN",19,6353,1,5,0) patients who are assigned to the team for something other than primary "KRN",19,6353,1,6,0) care. "KRN",19,6353,20) "KRN",19,6353,25) PROMPTS^SCRPEC "KRN",19,6353,99) 56693,59580 "KRN",19,6353,99.1) 58437,14480 "KRN",19,6353,"U") DETAILED PATIENT ASSIGNMENTS "MBREQ") 0 "ORD",18,19) 19;18;;;OPT^XPDTA;OPTF1^XPDIA;OPTE1^XPDIA;OPTF2^XPDIA;;OPTDEL^XPDIA "ORD",18,19,0) OPTION "PKG",16,-1) 1^1 "PKG",16,0) SCHEDULING^SD^APPOINTMENTS,PROFILES,LETTERS,AMIS REPORTS "PKG",16,20,0) ^9.402P^^ "PKG",16,22,0) ^9.49I^1^1 "PKG",16,22,1,0) 5.3^2930813 "PKG",16,22,1,"PAH",1,0) 535^3090123 "PKG",16,22,1,"PAH",1,1,0) ^^6^6^3090123 "PKG",16,22,1,"PAH",1,1,1,0) This patch contains fixes for the following issues: "PKG",16,22,1,"PAH",1,1,2,0) Computed date fields not printing the year when doing a Fileman inquiry "PKG",16,22,1,"PAH",1,1,3,0) Turn off option DPA Detailed Patient Assignments[SC PCMM DETAILED LIST "PKG",16,22,1,"PAH",1,1,4,0) PTS] "PKG",16,22,1,"PAH",1,1,5,0) Practitioners Patients report header issue "PKG",16,22,1,"PAH",1,1,6,0) Roll and scroll problem with PCMM enrollment "QUES","XPF1",0) Y "QUES","XPF1","??") ^D REP^XPDH "QUES","XPF1","A") Shall I write over your |FLAG| File "QUES","XPF1","B") YES "QUES","XPF1","M") D XPF1^XPDIQ "QUES","XPF2",0) Y "QUES","XPF2","??") ^D DTA^XPDH "QUES","XPF2","A") Want my data |FLAG| yours "QUES","XPF2","B") YES "QUES","XPF2","M") D XPF2^XPDIQ "QUES","XPI1",0) YO "QUES","XPI1","??") ^D INHIBIT^XPDH "QUES","XPI1","A") Want KIDS to INHIBIT LOGONs during the install "QUES","XPI1","B") NO "QUES","XPI1","M") D XPI1^XPDIQ "QUES","XPM1",0) PO^VA(200,:EM "QUES","XPM1","??") ^D MG^XPDH "QUES","XPM1","A") Enter the Coordinator for Mail Group '|FLAG|' "QUES","XPM1","B") "QUES","XPM1","M") D XPM1^XPDIQ "QUES","XPO1",0) Y "QUES","XPO1","??") ^D MENU^XPDH "QUES","XPO1","A") Want KIDS to Rebuild Menu Trees Upon Completion of Install "QUES","XPO1","B") NO "QUES","XPO1","M") D XPO1^XPDIQ "QUES","XPZ1",0) Y "QUES","XPZ1","??") ^D OPT^XPDH "QUES","XPZ1","A") Want to DISABLE Scheduled Options, Menu Options, and Protocols "QUES","XPZ1","B") YES "QUES","XPZ1","M") D XPZ1^XPDIQ "QUES","XPZ2",0) Y "QUES","XPZ2","??") ^D RTN^XPDH "QUES","XPZ2","A") Want to MOVE routines to other CPUs "QUES","XPZ2","B") NO "QUES","XPZ2","M") D XPZ2^XPDIQ "RTN") 2 "RTN","SCMCQK1") 0^2^B92256420^B90469007 "RTN","SCMCQK1",1,0) SCMCQK1 ;ALBOI/REW - Single Pt Tm/Pt Tm Pos Assign and Discharge;11/07/02 "RTN","SCMCQK1",2,0) ;;5.3;Scheduling;**148,177,231,264,436,297,446,524,535**;AUG 13, 1993;Build 3 "RTN","SCMCQK1",3,0) ; "RTN","SCMCQK1",4,0) ;04/25/2006 SD*5.3*446 INTER-FACILITY TRANSFER "RTN","SCMCQK1",5,0) UNTP ;unassign patient from pc prac position "RTN","SCMCQK1",6,0) I '$G(SCTP) W !,"No position defined" Q "RTN","SCMCQK1",7,0) N OK,SCER,SCCL,SCBEGIN,SCN,SCLIST,SCEND,SCINCL,SCLSEQ,SCDATES,SCDTS "RTN","SCMCQK1",8,0) S OK=0 "RTN","SCMCQK1",9,0) W !,"About to Unassign "_$$NAME(DFN)_" from: ",!,?8,$$POSITION(SCTP)_" position ["_$P($$GETPRTP^SCAPMCU2(SCTP,DT),U,2)_"]" "RTN","SCMCQK1",10,0) S SCDISCH=$$DATE("D") "RTN","SCMCQK1",11,0) G:SCDISCH<1 QTUNTP "RTN","SCMCQK1",12,0) G:'$$CONFIRM() QTUNTP "RTN","SCMCQK1",13,0) S OK=$$INPTSCTP^SCAPMC22(DFN,SCTP,SCDISCH,.SCER) ; og/sd/524 "RTN","SCMCQK1",14,0) G:OK'>0 QTUNTP "RTN","SCMCQK1",15,0) ;comment out following lines in SD*5.3*535 - clinic enrollment no longer used "RTN","SCMCQK1",16,0) ;S SCCL=$P($G(^SCTM(404.57,+$G(SCTP),0)),U,9) "RTN","SCMCQK1",17,0) ;I SCCL D DISCL "RTN","SCMCQK1",18,0) QTUNTP W !,"Position Unassignment "_$S(OK:"made.",1:"NOT made.") "RTN","SCMCQK1",19,0) Q "RTN","SCMCQK1",20,0) ENRCL ; no longer used with SD*5.3*535 "RTN","SCMCQK1",21,0) Q "RTN","SCMCQK1",22,0) N SCRESTA,SCREST,SCCLNM,SCTM "RTN","SCMCQK1",23,0) N SCCL "RTN","SCMCQK1",24,0) F SCCL=0:0 S SCCL=$O(^SCTM(404.57,+$G(SCTP),5,SCCL)) Q:'SCCL D "RTN","SCMCQK1",25,0) .Q:$$ACTCL(DFN,SCCL) "RTN","SCMCQK1",26,0) .W !!!,"The "_$$POSITION(SCTP)_" is associated with the ",$$CLINIC(SCCL)_" clinic." "RTN","SCMCQK1",27,0) .;SCRESTA = Array of pt's teams causing restricted consults "RTN","SCMCQK1",28,0) .N SCRESTA "RTN","SCMCQK1",29,0) .S SCREST=$$RESTPT^SCAPMCU4(DFN,DT,"SCRESTA") "RTN","SCMCQK1",30,0) .I SCREST D "RTN","SCMCQK1",31,0) ..N SCTM "RTN","SCMCQK1",32,0) ..S SCCLNM=Y "RTN","SCMCQK1",33,0) ..W !,?5,"Patient has restricted consults due to team assignment(s):" "RTN","SCMCQK1",34,0) ..S SCTM=0 "RTN","SCMCQK1",35,0) ..F S SCTM=$O(SCRESTA(SCTM)) Q:'SCTM W !,?10,SCRESTA(SCTM) "RTN","SCMCQK1",36,0) .I SCREST&'$G(SCOKCONS) D G QTECL "RTN","SCMCQK1",37,0) ..W !,?5,"This patient may only be enrolled in clinics via" "RTN","SCMCQK1",38,0) ..W !,?15,"Edit Clinic Enrollment Data option" "RTN","SCMCQK1",39,0) .W !,"Do you wish to enroll the patient from this clinic on " "RTN","SCMCQK1",40,0) .S Y=SCASSDT X ^DD("DD") W Y,"?" "RTN","SCMCQK1",41,0) .I $$YESNO() D "RTN","SCMCQK1",42,0) ..W !,"Clinic Enrollment" "RTN","SCMCQK1",43,0) ..I $$ACPTCL^SCAPMC18(DFN,SCCL,,SCASSDT,"SCENER") W " made" "RTN","SCMCQK1",44,0) ..E W "NOT made " "RTN","SCMCQK1",45,0) QTECL Q "RTN","SCMCQK1",46,0) DISCL ; no longer used with SD*5.3*535 "RTN","SCMCQK1",47,0) Q "RTN","SCMCQK1",48,0) N SCCL F SCCL=0:0 S SCCL=$O(^SCTM(404.57,+$G(SCTP),5,SCCL)) Q:'SCCL D "RTN","SCMCQK1",49,0) .Q:'$$ACTCL(DFN,SCCL) "RTN","SCMCQK1",50,0) .W !,$$NAME(DFN)," is enrolled in the associated "_$$CLINIC(SCCL)_" clinic." "RTN","SCMCQK1",51,0) .W !,"Do you wish to discharge the patient from this clinic on " "RTN","SCMCQK1",52,0) .S Y=SCDISCH X ^DD("DD") W Y,"?" "RTN","SCMCQK1",53,0) .Q:'$$YESNO() "RTN","SCMCQK1",54,0) .N SDFN,SDCLN S SDFN=DFN,SDCLN=SCCL "RTN","SCMCQK1",55,0) .N DFN D ^SDCD "RTN","SCMCQK1",56,0) QTDCL Q "RTN","SCMCQK1",57,0) UNTM ; "RTN","SCMCQK1",58,0) ;assign patient from pc team (and pc position if possible) "RTN","SCMCQK1",59,0) N OK,SCER,SCBEGIN,SCN,SCLIST,SCEND,SCINCL,SCLSEQ,SCDATES,SCDTS,OK2,OK3 "RTN","SCMCQK1",60,0) S OK=0 "RTN","SCMCQK1",61,0) W !!,"About to Unassign "_$$NAME(DFN)_" from "_$$TEAMNM(SCTM)_" team" "RTN","SCMCQK1",62,0) W:'SCTPSTAT !,?5,"AND from "_$$POSITION(SCTP)_" position ["_$$WRITETP^SCMCDD1(SCTP)_"]" "RTN","SCMCQK1",63,0) S SCDISCH=$$DATE("D") "RTN","SCMCQK1",64,0) G:SCDISCH<1 QTUNTM "RTN","SCMCQK1",65,0) G:'$$CONFIRM() QTUNTM "RTN","SCMCQK1",66,0) IF 'SCTPSTAT D G:OK2'>0 QTUNTM "RTN","SCMCQK1",67,0) .W !,"PC assignment unassigned." "RTN","SCMCQK1",68,0) .S OK2=$$INPTSCTP^SCAPMC22(DFN,SCTP,SCDISCH,.SCER) "RTN","SCMCQK1",69,0) .IF OK2>0 D "RTN","SCMCQK1",70,0) ..W "made." "RTN","SCMCQK1",71,0) ..S SCCL=$P(^SCTM(404.57,SCTP,0),U,9) "RTN","SCMCQK1",72,0) ..;D:SCCL DISCL ;commented out in SD*5.3*535 "RTN","SCMCQK1",73,0) S OK3=$$ALLPOS() "RTN","SCMCQK1",74,0) IF $$OKINPTTM^SCMCTMU2(DFN,SCTM,SCDISCH) D "RTN","SCMCQK1",75,0) .S OK=$$INPTSCTM^SCAPMC7(DFN,SCTM,SCDISCH,.SCER) "RTN","SCMCQK1",76,0) ELSE D "RTN","SCMCQK1",77,0) .W !,"Future/Current Patient-Position Assignment exists" "RTN","SCMCQK1",78,0) QTUNTM W !,"Team Unassignment "_$S(OK:"made",1:"NOT made.") "RTN","SCMCQK1",79,0) Q "RTN","SCMCQK1",80,0) ALLPOS() ;unassign all patient-positions for team "RTN","SCMCQK1",81,0) ;not stand-alone - needs dfn,sctm "RTN","SCMCQK1",82,0) ;return 1=No positions left assigned|0=At least 1 position assigned "RTN","SCMCQK1",83,0) N OK,SCDT1,SCPTTPX,SCERRR,SCTP,SCCNT,SCPTTPI,SCLOC,SCNODE,SCPTTP2 "RTN","SCMCQK1",84,0) S SCDT1("BEGIN")=SCDISCH+1 "RTN","SCMCQK1",85,0) S SCDT1("END")=3990101 "RTN","SCMCQK1",86,0) S SCDT1("INCL")=0 ;anytime from now to future "RTN","SCMCQK1",87,0) S OK=$$TPPT^SCAPMC23(DFN,"SCDT1",,,,,,"SCPTTPX",.SCERRR) "RTN","SCMCQK1",88,0) S (SCTP,SCCNT)=0 "RTN","SCMCQK1",89,0) W !,"Checking for other position assignments to team..." "RTN","SCMCQK1",90,0) F S SCTP=$O(SCPTTPX("SCTP",SCTM,SCTP)) Q:'SCTP S SCCNT=SCCNT+1 D "RTN","SCMCQK1",91,0) .S SCPTTPI=$O(SCPTTPX("SCTP",SCTM,SCTP,9999999),-1) "RTN","SCMCQK1",92,0) .S SCLOC=$O(SCPTTPX("SCTP",SCTM,SCTP,SCPTTPI,0)) "RTN","SCMCQK1",93,0) .S SCNODE=SCPTTPX(SCLOC) "RTN","SCMCQK1",94,0) .S SCPTTP2(SCTP)="" "RTN","SCMCQK1",95,0) .W !,?3,$P(SCNODE,U,2)," ",$P(SCNODE,U,8) "RTN","SCMCQK1",96,0) .IF $P(SCNODE,U,6)!(SCDISCH'>$P(SCNODE,U,5)) D "RTN","SCMCQK1",97,0) ..W !,?5,"Unassignment date already exists or unassignment after assignment date" "RTN","SCMCQK1",98,0) ..W !,?15,"- Correct via PCMM GUI" "RTN","SCMCQK1",99,0) ..S OK=0 "RTN","SCMCQK1",100,0) W !,?5,$S(SCCNT:SCCNT,1:"No")_" current/future position assignment(s)" "RTN","SCMCQK1",101,0) G:'OK!('SCCNT) QTALL "RTN","SCMCQK1",102,0) W !!,"About to unassign the above patient-position assignments" "RTN","SCMCQK1",103,0) IF '$$CONFIRM S OK=0 G QTALL "RTN","SCMCQK1",104,0) S SCTP=0 "RTN","SCMCQK1",105,0) F S SCTP=$O(SCPTTP2(SCTP)) Q:'SCTP D Q:'OK "RTN","SCMCQK1",106,0) .S OK=$$INPTSCTP^SCAPMC22(DFN,SCTP,SCDISCH,.SCER) "RTN","SCMCQK1",107,0) .W:'OK !,?10,"Problem with unassignment, correct via PCMM GUI" "RTN","SCMCQK1",108,0) QTALL Q OK "RTN","SCMCQK1",109,0) ASTM ;assign patient to PC team "RTN","SCMCQK1",110,0) N DIC,Y,OK,SCTM,SCTMFLDS,SCER,SCBEGIN,SCN,SCLIST,SCEND,SCINCL,SCLSEQ,SCDATES,SCDTS "RTN","SCMCQK1",111,0) S OK=0 "RTN","SCMCQK1",112,0) W !!,"About to Assign "_$$NAME(DFN)_" to a primary care team" "RTN","SCMCQK1",113,0) I $$SC(DFN) W !!,"********** This patient is 50 percent or greater service-connected ************" "RTN","SCMCQK1",114,0) S DIC="^SCTM(404.51," "RTN","SCMCQK1",115,0) S DIC(0)="AEMQZ" "RTN","SCMCQK1",116,0) S DIC("S")="IF $$ACTTM^SCMCTMU(Y,DT)&($P($G(^SCTM(404.51,Y,0)),U,5))" "RTN","SCMCQK1",117,0) ;select from active teams that can be PC Teams "RTN","SCMCQK1",118,0) D ^DIC "RTN","SCMCQK1",119,0) G:Y<1 QTASTM "RTN","SCMCQK1",120,0) S SCTM=+Y "RTN","SCMCQK1",121,0) ;The following logic to present warning message added per SD*5.3*436 "RTN","SCMCQK1",122,0) I $P($G(^SCTM(404.51,SCTM,0)),U,10) D G:'SCFLAG QTASTM "RTN","SCMCQK1",123,0) .S SCFLAG=0 "RTN","SCMCQK1",124,0) .W !!,"This team is closed to further patient assignments. While you are" "RTN","SCMCQK1",125,0) .W !,"not currently prevented from assigning this patient, you may want to" "RTN","SCMCQK1",126,0) .W !,"check before continuing." "RTN","SCMCQK1",127,0) .Q:'$$YESNO1() ; new function call per SD*5.3*436 "RTN","SCMCQK1",128,0) .Q:'$$CONFIRM() "RTN","SCMCQK1",129,0) .S SCFLAG=1 W ! "RTN","SCMCQK1",130,0) S SCASSDT=$$DATE("A") "RTN","SCMCQK1",131,0) G:SCASSDT<1 QTASTM "RTN","SCMCQK1",132,0) S SCTMCT=$$TEAMCNT^SCAPMCU1(SCTM) "RTN","SCMCQK1",133,0) S SCTMMAX=$P($$GETEAM^SCAPMCU3(SCTM),"^",8) "RTN","SCMCQK1",134,0) I SCTMCT'0 "RTN","SCMCQK1",209,0) YESNO1() ; added per SD*5.3*436 "RTN","SCMCQK1",210,0) N DIR,X,Y "RTN","SCMCQK1",211,0) S DIR(0)="Y",DIR("A")="Do you wish to assign this patient now (Yes/No)?" "RTN","SCMCQK1",212,0) S DIR("B")="NO" "RTN","SCMCQK1",213,0) D ^DIR "RTN","SCMCQK1",214,0) Q Y>0 "RTN","SCMCQK1",215,0) YESNO2() ; "RTN","SCMCQK1",216,0) N DIR,X,Y "RTN","SCMCQK1",217,0) S DIR(0)="Y",DIR("B")="NO" "RTN","SCMCQK1",218,0) S DIR("A")="Do you wish to continue with the assignment (Yes/No)?" "RTN","SCMCQK1",219,0) D ^DIR "RTN","SCMCQK1",220,0) Q Y>0 "RTN","SCMCQK1",221,0) CONFIRM() ;confirmation call "RTN","SCMCQK1",222,0) N DIR,X,Y "RTN","SCMCQK1",223,0) S DIR("A")="Are you sure (Yes/No)" "RTN","SCMCQK1",224,0) S DIR(0)="Y" "RTN","SCMCQK1",225,0) D ^DIR "RTN","SCMCQK1",226,0) Q +Y=1 "RTN","SCMCQK1",227,0) SELPOS() ;return way to select position: 1=PRACT,2=POSIT,3=NONE "RTN","SCMCQK1",228,0) N DIR,X,Y "RTN","SCMCQK1",229,0) W !,"Choose way to select PC POSITION Assignment: " "RTN","SCMCQK1",230,0) S DIR(0)="SO^0:NONE;1:BY PRACTITIONER ASSIGNMENT;2:BY POSITION ASSIGNMENT" "RTN","SCMCQK1",231,0) S DIR("B")=1 "RTN","SCMCQK1",232,0) D ^DIR "RTN","SCMCQK1",233,0) Q $S(Y'>0:"",+Y=1:"PRACT",1:"POSIT") "RTN","SCMCQK1",234,0) DATE(TYPE) ;return date type=A or D "RTN","SCMCQK1",235,0) N DIR,X,Y "RTN","SCMCQK1",236,0) S DIR("A")=$S(TYPE="A":"Assignment",1:"Unassignment")_" date: " "RTN","SCMCQK1",237,0) S DIR(0)="DA^::EXP" "RTN","SCMCQK1",238,0) S Y=$S($D(SCDISCH):SCDISCH,$D(SCASSDT):SCASSDT,(TYPE="A"):"TODAY",1:"TODAY-1") "RTN","SCMCQK1",239,0) X ^DD("DD") "RTN","SCMCQK1",240,0) S DIR("B")=Y "RTN","SCMCQK1",241,0) D ^DIR "RTN","SCMCQK1",242,0) Q Y "RTN","SCMCQK1",243,0) ACTCL(DFN,SCCL) ;is patient enrolled in clinic? - not called with SD*5.3*535 "RTN","SCMCQK1",244,0) Q "RTN","SCMCQK1",245,0) N SCXX "RTN","SCMCQK1",246,0) S SCXX=$O(^DPT(DFN,"DE","B",SCCL,9999),-1) "RTN","SCMCQK1",247,0) Q $S('SCXX:0,($P(^DPT(DFN,"DE",+SCXX,0),U,2)="I"):0,1:1) "RTN","SCMCQK1",248,0) PRACSCR(SC40452) ;screen for for file 404.52 "RTN","SCMCQK1",249,0) N SCP,SCNODE,OK "RTN","SCMCQK1",250,0) S SCP=$G(^SCTM(404.52,SC40452,0)) "RTN","SCMCQK1",251,0) S OK=0 "RTN","SCMCQK1",252,0) G:'SCP QTPP "RTN","SCMCQK1",253,0) S SCNODE=$G(^SCTM(404.57,+SCP,0)) "RTN","SCMCQK1",254,0) S OK=$S($P(SCNODE,U,2)'=SCTM:0,'$P(SCNODE,U,4):0,($O(^SCTM(404.52,"AIDT",+SCP,1,""))'=-$P(SCP,U,2)):0,($O(^SCTM(404.52,"AIDT",+SCP,0,-$P(SCP,U,2)),-1)):0,($$ACTTP^SCMCTPU(+SCP)>0):1,1:0) "RTN","SCMCQK1",255,0) QTPP Q OK "RTN","SCMCQK1",256,0) POSSCR(SCTP) ;screen for file 404.57 "RTN","SCMCQK1",257,0) N SCNODE "RTN","SCMCQK1",258,0) S SCNODE=$G(^SCTM(404.57,SCTP,0)) "RTN","SCMCQK1",259,0) Q $S($P(SCNODE,U,2)'=SCTM:0,'$P(SCNODE,U,4):0,($$ACTTP^SCMCTPU(SCTP)>0):1,1:0) "RTN","SCMCQK1",260,0) Q "RTN","SCMCQK1",261,0) WAITYN() ; "RTN","SCMCQK1",262,0) N %,OK,Y "RTN","SCMCQK1",263,0) I SCTMCT1,1:1) Q 0 "RTN","SCMCQK1",265,0) N DIR,X,Y "RTN","SCMCQK1",266,0) S DIR(0)="Y",DIR("B")="NO" "RTN","SCMCQK1",267,0) S DIR("A")="Do you wish to place the patient on the wait list (Yes/No)?" "RTN","SCMCQK1",268,0) D ^DIR "RTN","SCMCQK1",269,0) I Y=1 S Y=$$WAITS^SCMCWAIT(DFN,SCTM,$G(SCTP),$G(SC)) I Y>0 W !,"Patient Placed on Wait List" "RTN","SCMCQK1",270,0) Q Y>0 "RTN","SCMCQK1",271,0) SC(DFN) ;Is patient 50 to 100% "RTN","SCMCQK1",272,0) D ELIG^VADPT Q $P($G(VAEL(3)),U,2)>49 "RTN","SCRPPAT3") 0^1^B32341023^B33197824 "RTN","SCRPPAT3",1,0) SCRPPAT3 ;ALB/CMM - Practitioner's Patients ; 8/30/99 3:14pm "RTN","SCRPPAT3",2,0) ;;5.3;Scheduling;**41,52,148,174,181,177,297,526,520,535**;AUG 13, 1993;Build 3 "RTN","SCRPPAT3",3,0) ; "RTN","SCRPPAT3",4,0) ;Listing of Practitioner's Patients "RTN","SCRPPAT3",5,0) ; "RTN","SCRPPAT3",6,0) PAT(INS,SEC,TRD,SEC3,ST3,ST4,POS) ; "RTN","SCRPPAT3",7,0) ;writes patients for position/practitioner "RTN","SCRPPAT3",8,0) N PTN,PT,FIRST "RTN","SCRPPAT3",9,0) S PTN="",FIRST=1 "RTN","SCRPPAT3",10,0) I SUMM D TOTAL1^SCRPPAT3(INS,SEC,TRD,POS) Q ;Summary only "RTN","SCRPPAT3",11,0) F S PTN=$O(@STORE@("PT",INS,SEC,TRD,POS,PTN)) Q:PTN=""!(STOP) D "RTN","SCRPPAT3",12,0) .S PT=0 "RTN","SCRPPAT3",13,0) .F S PT=$O(@STORE@("PT",INS,SEC,TRD,POS,PTN,PT)) Q:'PT!(STOP) D "RTN","SCRPPAT3",14,0) ..I FIRST D HEADER S FIRST=0 "RTN","SCRPPAT3",15,0) ..W !,$G(@STORE@(INS,SEC,TRD,POS,PT)) ;print patient detail line "RTN","SCRPPAT3",16,0) ..N SCCN "RTN","SCRPPAT3",17,0) ..S SCCN="" "RTN","SCRPPAT3",18,0) ..F S SCCN=$O(@STORE@(INS,SEC,TRD,POS,PT,SCCN)) Q:SCCN="" D "RTN","SCRPPAT3",19,0) ...W !,$G(@STORE@(INS,SEC,TRD,POS,PT,SCCN)) ;print patient detail line "RTN","SCRPPAT3",20,0) ...Q:STOP "RTN","SCRPPAT3",21,0) ..Q "RTN","SCRPPAT3",22,0) .I (IOST'?1"C-".E),$Y>(IOSL-5) S MORE=0 D NEWP1^SCRPU3(.PAGE,TITL) D:'STOP HEAD2(INS,SEC,TRD,SEC3,ST3,ST4,POS) D:(('FIRST&'STOP)!($G(SORT)=3)) HEADER "RTN","SCRPPAT3",23,0) .I (IOST?1"C-".E),$Y>(IOSL-5) S MORE=0 D HOLD^SCRPU3(.PAGE,TITL) D:'STOP HEAD2(INS,SEC,TRD,SEC3,ST3,ST4,POS) D:'FIRST&'STOP HEADER "RTN","SCRPPAT3",24,0) .Q "RTN","SCRPPAT3",25,0) Q "RTN","SCRPPAT3",26,0) ; "RTN","SCRPPAT3",27,0) SPRINT(STORE,IOP,TITL,SORT) ; Summary Print Only "RTN","SCRPPAT3",28,0) ;STORE - global location of data "RTN","SCRPPAT3",29,0) ;IOP - device to print to "RTN","SCRPPAT3",30,0) ;TITL - title of report "RTN","SCRPPAT3",31,0) ;SORT - sort order 1-div,team,pract/2-div,pract,team "RTN","SCRPPAT3",32,0) ; "RTN","SCRPPAT3",33,0) N PAGE "RTN","SCRPPAT3",34,0) S PAGE=1,STOP=0 "RTN","SCRPPAT3",35,0) D OPEN^SCRPU3 "RTN","SCRPPAT3",36,0) Q:$G(POP) "RTN","SCRPPAT3",37,0) D TITLE^SCRPU3(.PAGE,TITL) "RTN","SCRPPAT3",38,0) D CLOSE^SCRPU3 "RTN","SCRPPAT3",39,0) Q "RTN","SCRPPAT3",40,0) ; "RTN","SCRPPAT3",41,0) TOTAL1(INS,SEC,TRD,POS) ; "RTN","SCRPPAT3",42,0) ;print team/practitioner total "RTN","SCRPPAT3",43,0) N TEM,PRC "RTN","SCRPPAT3",44,0) I SORT=1 S TEM=SEC,PRC=TRD "RTN","SCRPPAT3",45,0) I SORT=2!(SORT=3) S TEM=TRD,PRC=SEC "RTN","SCRPPAT3",46,0) W !!,$G(@STORE@("TH",INS,PRC,TEM,POS)),$G(@STORE@("TOTAL",INS,PRC,TEM,POS)) "RTN","SCRPPAT3",47,0) Q "RTN","SCRPPAT3",48,0) ; "RTN","SCRPPAT3",49,0) HEAD2(INS,SEC,TRD,SEC3,ST3,ST4,POS) ; "RTN","SCRPPAT3",50,0) I (SEC3="""TN""")&($D(@ST4@(INS,TRD,SEC))) D "RTN","SCRPPAT3",51,0) .W !,$G(@ST3@(INS,SEC)) ;write team (sort 1) "RTN","SCRPPAT3",52,0) .W !,$G(@STORE@(INS)) "RTN","SCRPPAT3",53,0) .W !,$G(@ST4@(INS,TRD,SEC,POS)) ;write practitioner (sort 2) "RTN","SCRPPAT3",54,0) .I $L($G(@STORE@("PN",INS,TRD,SEC,POS,"PRCP"))) W !,@STORE@("PN",INS,TRD,SEC,POS,"PRCP") "RTN","SCRPPAT3",55,0) .W ! "RTN","SCRPPAT3",56,0) I (SEC3="""PN""")&($D(@ST3@(INS,SEC,TRD))) D "RTN","SCRPPAT3",57,0) .W !,$G(@ST3@(INS,SEC,TRD,POS)) ;write practitioner (sort 1) "RTN","SCRPPAT3",58,0) .I $G(SORT)'=3 I $L($G(@STORE@("PN",INS,SEC,TRD,POS,"PRCP"))) W !,@STORE@("PN",INS,SEC,TRD,POS,"PRCP") "RTN","SCRPPAT3",59,0) .I $G(SORT)'=3 W !,$G(@ST4@(INS,TRD)) ;write team (sort 2) "RTN","SCRPPAT3",60,0) .W !,$G(@STORE@(INS)) "RTN","SCRPPAT3",61,0) Q "RTN","SCRPPAT3",62,0) ; "RTN","SCRPPAT3",63,0) HEADER ; "RTN","SCRPPAT3",64,0) Q:$G(MORE) "RTN","SCRPPAT3",65,0) I SORT=3 S MORE=1 "RTN","SCRPPAT3",66,0) N NXT "RTN","SCRPPAT3",67,0) F NXT="H1","H2","H3" W !,$G(@STORE@(NXT)) "RTN","SCRPPAT3",68,0) W ! "RTN","SCRPPAT3",69,0) Q "RTN","SCRPPAT3",70,0) ; "RTN","SCRPPAT3",71,0) SHEAD ; "RTN","SCRPPAT3",72,0) S @STORE@("H2")="Pt Name" "RTN","SCRPPAT3",73,0) S $E(@STORE@("H2"),15)="Pt ID" "RTN","SCRPPAT3",74,0) S $E(@STORE@("H1"),25)="M.T." "RTN","SCRPPAT3",75,0) S $E(@STORE@("H2"),25)="Stat" "RTN","SCRPPAT3",76,0) S $E(@STORE@("H1"),31)="Prim" "RTN","SCRPPAT3",77,0) S $E(@STORE@("H2"),31)="Elig" "RTN","SCRPPAT3",78,0) ;Removed by patch 174 "RTN","SCRPPAT3",79,0) ;S $E(@STORE@("H1"),39)="Pat" "RTN","SCRPPAT3",80,0) ;S $E(@STORE@("H2"),39)="Stat" "RTN","SCRPPAT3",81,0) S $E(@STORE@("H1"),42)="Last" "RTN","SCRPPAT3",82,0) S $E(@STORE@("H2"),42)="Appt" "RTN","SCRPPAT3",83,0) S $E(@STORE@("H1"),54)="Next" "RTN","SCRPPAT3",84,0) S $E(@STORE@("H2"),54)="Appt" "RTN","SCRPPAT3",85,0) S $E(@STORE@("H2"),66)="Clinic" "RTN","SCRPPAT3",86,0) S $P(@STORE@("H3"),"=",81)="" "RTN","SCRPPAT3",87,0) Q "RTN","SCRPPAT3",88,0) ALL ; "RTN","SCRPPAT3",89,0) ;get all practitioners for all teams selected "RTN","SCRPPAT3",90,0) I TEAM=1 D TALL ;all teams selected "RTN","SCRPPAT3",91,0) N TIEN,OKAY,XLIST,YLIST,SCTP,SCI,SCDT "RTN","SCRPPAT3",92,0) S TIEN="" "RTN","SCRPPAT3",93,0) F S TIEN=$O(TEAM(TIEN)) Q:TIEN=""!(TIEN'?.N) D "RTN","SCRPPAT3",94,0) .I $D(TEAM(TIEN)) D "RTN","SCRPPAT3",95,0) ..K XLIST "RTN","SCRPPAT3",96,0) ..S OKAY=$$TPTM^SCAPMC(TIEN,"","","","XLIST","ERROR") "RTN","SCRPPAT3",97,0) ..S SCTP=0 F S SCTP=$O(XLIST("SCTP",TIEN,SCTP)) Q:'SCTP D "RTN","SCRPPAT3",98,0) ...K YLIST S SCDT="SCDT",(SCDT("BEGIN"),SCDT("END"))=DT,SCDT("INCL")=0 "RTN","SCRPPAT3",99,0) ...S OKAY=$$PRTP^SCAPMC(SCTP,.SCDT,"YLIST","ERROR",1,0) "RTN","SCRPPAT3",100,0) ...S SCI=0 F S SCI=$O(YLIST(SCI)) Q:'SCI D "RTN","SCRPPAT3",101,0) ....S @TPRC@(0)=$G(@TPRC@(0))+1 "RTN","SCRPPAT3",102,0) ....S @TPRC@(@TPRC@(0))=YLIST(SCI) "RTN","SCRPPAT3",103,0) Q "RTN","SCRPPAT3",104,0) ; "RTN","SCRPPAT3",105,0) TALL ; "RTN","SCRPPAT3",106,0) ;get all active team for divisions selected "RTN","SCRPPAT3",107,0) N NXT,IIEN,NODE "RTN","SCRPPAT3",108,0) S NXT=0,IIEN="" "RTN","SCRPPAT3",109,0) ;$O through team file and find all active teams for selected divisions "RTN","SCRPPAT3",110,0) F S IIEN=$O(^SCTM(404.51,"AINST",IIEN)) Q:IIEN="" D "RTN","SCRPPAT3",111,0) .I INST=1!$D(INST(IIEN)) D "RTN","SCRPPAT3",112,0) ..S TIEN=0 "RTN","SCRPPAT3",113,0) ..F S TIEN=$O(^SCTM(404.51,"AINST",IIEN,TIEN)) Q:TIEN="" D "RTN","SCRPPAT3",114,0) ...I $$ACTTM^SCMCTMU(TIEN) S TEAM(TIEN)="" "RTN","SCRPPAT3",115,0) Q "RTN","SCRPPAT3",116,0) ; "RTN","SCRPPAT3",117,0) SETUP(IIEN,INAME,TIEN,TNAME,PRAC,PNAME,POSN,TPI,PRCP) ; "RTN","SCRPPAT3",118,0) ;setup data "RTN","SCRPPAT3",119,0) S IIEN=+$P($G(^SCTM(404.51,TIEN,0)),"^",7) ;institution ien "RTN","SCRPPAT3",120,0) S INAME=$P($G(^DIC(4,IIEN,0)),"^") ;institution name "RTN","SCRPPAT3",121,0) I INAME="" S INAME="[BAD DATA]" "RTN","SCRPPAT3",122,0) ; "RTN","SCRPPAT3",123,0) I PNAME="" S PNAME="[BAD DATA]" "RTN","SCRPPAT3",124,0) I TNAME="" S TNAME="[BAD DATA]" "RTN","SCRPPAT3",125,0) I $G(SORT)=3 S IIEN=1,TIEN=1 "RTN","SCRPPAT3",126,0) I '$D(@STORE@("PN",IIEN,PRAC,TIEN,TPI)) S @STORE@("PN",IIEN,PRAC,TIEN,TPI)="Practitioner: "_PNAME_$S(SORT=3:"",1:" ("_POSN_")") "RTN","SCRPPAT3",127,0) I $L(PRCP) S @STORE@("PN",IIEN,PRAC,TIEN,TPI,"PRCP")=" Preceptor: "_PRCP "RTN","SCRPPAT3",128,0) I '$D(@STORE@("TN",IIEN,$S($G(SORT)=3:1,1:TIEN))) S @STORE@("TN",IIEN,$S($G(SORT)=3:1,1:TIEN))=" Team: "_TNAME "RTN","SCRPPAT3",129,0) ; "RTN","SCRPPAT3",130,0) I '$D(@STORE@("I",$S($G(SORT)=3:"S3",1:INAME),IIEN)) S @STORE@("I",$S($G(SORT)=3:"S3",1:INAME),IIEN)="",@STORE@(IIEN)=$S(SORT=3:"",1:" Division: "_INAME) "RTN","SCRPPAT3",131,0) S @STORE@("T",IIEN,$S($G(SORT)=3:"T3",1:TNAME),$S($G(SORT)=3:1,1:TIEN))="" "RTN","SCRPPAT3",132,0) I '$D(@STORE@("P",IIEN,PNAME,PRAC,TPI)) S @STORE@("P",IIEN,PNAME,PRAC,TPI)="" "RTN","SCRPPAT3",133,0) I '$D(@STORE@("TOTAL",IIEN,PRAC,0)) S @STORE@("TOTAL",IIEN,PRAC,0)=0 "RTN","SCRPPAT3",134,0) I '$D(@STORE@("TOTAL",IIEN,PRAC,TIEN)) S @STORE@("TOTAL",IIEN,PRAC,TIEN)=0 "RTN","SCRPPAT3",135,0) ; "RTN","SCRPPAT3",136,0) S @STORE@("TH",IIEN,PRAC)="Patient Count for "_PNAME_": " "RTN","SCRPPAT3",137,0) S @STORE@("TH",IIEN,PRAC,TIEN,TPI)="Patient Count for "_PNAME_": " "RTN","SCRPPAT3",138,0) N SCX "RTN","SCRPPAT3",139,0) S SCX=$E(PNAME,1,22),$E(SCX,25)=$E(POSN,1,22),$E(SCX,49)=$E(TNAME,1,22) "RTN","SCRPPAT3",140,0) S @STORE@("SUM0",IIEN,PRAC,TIEN,TPI)=SCX "RTN","SCRPPAT3",141,0) ; "RTN","SCRPPAT3",142,0) S @STORE@("TH",IIEN)="** Note: Patient Panel Count is a count of unique patients for each practitioner" "RTN","SCRPPAT3",143,0) Q 0 "VER") 8.0^22.0 "^DD",404.57,404.57,301,0) CURRENT EFFECTIVE DATE^CJ12^^ ; ^N Y S X="" S Y=$P($$ACTTP^SCMCTPU(D0),U,2) D DD^%DT S X=Y "^DD",404.57,404.57,301,9) ^ "^DD",404.57,404.57,301,9.01) "^DD",404.57,404.57,301,9.1) N Y S X="" S Y=$P($$ACTTP^SCMCTPU(D0),U,2) D DD^%DT S X=Y "^DD",404.57,404.57,301,21,0) ^^1^1^2950807^^^^ "^DD",404.57,404.57,301,21,1,0) This is the most recent date (not in future) that the active status changed. "^DD",404.57,404.57,301,"DT") 3070709 "^DD",404.57,404.57,302,0) CURRENT ACTIVATION DATE^CJ12^^ ; ^N Y S X="" S Y=$P($$DATES^SCAPMCU1(404.59,D0,DT),U,2) D DD^%DT S X=Y "^DD",404.57,404.57,302,9) ^ "^DD",404.57,404.57,302,9.01) "^DD",404.57,404.57,302,9.1) N Y S X="" S Y=$P($$DATES^SCAPMCU1(404.59,D0,DT),U,2) D DD^%DT S X=Y "^DD",404.57,404.57,302,21,0) ^^4^4^2950807^^^^ "^DD",404.57,404.57,302,21,1,0) This is the activation date of the position based on today's date: "^DD",404.57,404.57,302,21,2,0) For positions never active - this is the next date where the position is active "^DD",404.57,404.57,302,21,3,0) For positions that are active now - this is the date it became active "^DD",404.57,404.57,302,21,4,0) For positions that are currently inactive - this is the last activation date "^DD",404.57,404.57,302,"DT") 3070709 "^DD",404.57,404.57,303,0) CURRENT INACTIVATION DATE^CJ12^^ ; ^N Y S X="" S Y=$P($$DATES^SCAPMCU1(404.59,D0,DT),U,3) D DD^%DT S X=Y "^DD",404.57,404.57,303,9) ^ "^DD",404.57,404.57,303,9.01) "^DD",404.57,404.57,303,9.1) N Y S X="" S Y=$P($$DATES^SCAPMCU1(404.59,D0,DT),U,3) D DD^%DT S X=Y "^DD",404.57,404.57,303,21,0) ^^2^2^2950807^^^^ "^DD",404.57,404.57,303,21,1,0) If it is inactive, this is the day the position became inactive. If it is "^DD",404.57,404.57,303,21,2,0) active it is the day the position will become inactive. "^DD",404.57,404.57,303,"DT") 3070709 "BLD",7954,6) ^453 **END** **END**