SD53793P ;MNT/BJR - Inactivate VCL/VCP Clinics ; Aug 03, 2021@07:22
;;5.3;Scheduling;**793**;Aug 13, 1993;Build 9
;
Q
;References to DELETE^XPDPROT in ICR #5567
;References to OUT^XPDPROT in ICR #5567
;References to OUT^XPDMENU in ICR #1157
;References to BMES^XPDUTL in ICR #10141
;References to XREF^XQORM in ICR #10140
;References to GET1^DIQ in ICR #2056
;References to GOTLOCAL^XMXAPIG in ICR #3006
;References to ^XMD in ICR #10070
;References to ^DIE in ICR #10013
;References to file 40.8 in ICR #2295
;
;Post-init routine for EWL Decommission
;
;
EN ;Entry point for SD*5.3*793 Post Install routine
K ^TMP("SD793P",$J)
D INACLN
D DISCLN
D DISWL
D WLDIS
D SDWLCHK
D VCLOPEN
K ^TMP("SD793P",$J)
Q
INACLN ;Inactivate VCL/VCP clinics
N SDCLN,SDCLNS,SDWLCLN,DR,DA,DIE,DIK,SDTXT,SDCLIEN,SDDATE,SDI,SDX1,SDZZNM,SDFLG,SDAPPT,SDNUM,SDINST,SDDIV,SDT
S SDCLN=0 F S SDCLN=$O(^SC(SDCLN)) Q:'SDCLN D
.S SDFLG=0
.S SDCLNS=SDCLN_",",SDX1=9999999
.S SDDATE=$P($$NOW^XLFDT,".")
.S SDWLCLN=$O(^SDWL(409.32,"B",SDCLN,""))
.I $$GET1^DIQ(44,SDCLNS,.01)["VCL"!($$GET1^DIQ(44,SDCLNS,.01)["VCP") S SDFLG=1
.Q:'SDFLG
.Q:($$GET1^DIQ(44,SDCLNS,8)'="COMMUNITY CARE CONSULT")
.S SDAPPT=DT F S SDAPPT=$O(^SC(SDCLN,"S",SDAPPT)) Q:'SDAPPT D
..S SDNUM=0 F S SDNUM=$O(^SC(SDCLN,"S",SDAPPT,1,SDNUM)) Q:'SDNUM I $P($G(^SC(SDCLN,"S",SDAPPT,1,SDNUM,0)),U,9)="" S SDFLG=0 D
...S ^TMP("SD793P",$J,"OPEN",SDCLN)=$$GET1^DIQ(44,SDCLNS,.01)
.Q:'SDFLG
.S SDINST=$$GET1^DIQ(44,SDCLNS,3) I SDINST="" S SDDIV=$$GET1^DIQ(44,SDCLNS,3.5,"I"),SDINST=$$GET1^DIQ(40.8,SDDIV,.07)
.I SDWLCLN D INACTWL(SDWLCLN),DISP(SDCLN)
.I $P($G(^SC(SDCLN,"I")),U)'="",$P($G(^SC(SDCLN,"I")),U,2)="" Q
.S SDZZNM="ZZ"_$E($$GET1^DIQ(44,SDCLNS,.01),1,28)
.S DR=".01///^S X=SDZZNM;2505///^S X=DT;2506///@",DIE="^SC(",DA=SDCLN D ^DIE
.F SDI=SDDATE-.0001:0 S SDI=$O(^SC(SDCLN,"ST",SDI)) Q:'SDI!(SDI>SDX1) S DA=SDI,DA(1)=SDCLN,DIK="^SC(SDCLN,""ST""," D ^DIK
.F SDI=SDDATE-.0001:0 S SDI=$O(^SC(SDCLN,"T",SDI)) Q:'SDI!(SDI>SDX1) S DA=SDI,DA(1)=SDCLN,DIK="^SC(SDCLN,""T""," D ^DIK
.F SDI=SDDATE-.0001:0 S SDI=$O(^SC(SDCLN,"OST",SDI)) Q:'SDI!(SDI>SDX1) S DA=SDI,DA(1)=SDCLN,DIK="^SC(SDCLN,""OST""," D ^DIK
.F SDI=0:1:6 S SDT="T"_SDI I $D(^SC(SDCLN,SDT,9999999)) S ^SC(SDCLN,SDT,DT,0)=DT,^SC(SDCLN,SDT,DT,1)=^SC(SDCLN,SDT,9999999,1),^SC(SDCLN,SDT,9999999,1)=""
.D SDEC^SDNACT(SDCLN,DT)
.S SDTXT="VCL/VCP Clinic "_$$GET1^DIQ(44,SDCLNS,.01)_" has been inactivated." D BMES^XPDUTL(SDTXT)
.S ^TMP("SD793P",$J,"CLIN",SDCLN)=$$GET1^DIQ(44,SDCLNS,.01)
Q
INACTWL(SDWLCLN) ;Inactivate SDWL Clinic
N SDWLCLS,SDTXT,DR,DA,DIE
Q:$P(^SDWL(409.32,SDWLCLN,0),U,4) ;Quit if already inactivated
S SDWLCLS=SDWLCLN_","
I $P(^SDWL(409.32,SDWLCLN,0),U,6)="" S DR=".02///^S X=SDINST",DIE="^SDWL(409.32,",DA=SDWLCLN D ^DIE ;File missing institution to avoid Fileman error
I $P(^SDWL(409.32,SDWLCLN,0),U,6)="" S SDTXT="VCL/VCP Wait List Clinic "_$$GET1^DIQ(409.32,SDWLCLS,.01)_" is missing required Institution and cannot be inactivated." D BMES^XPDUTL(SDTXT) Q
S DR="3///^S X=DT;4///^S X=.5",DIE="^SDWL(409.32,",DA=SDWLCLN D ^DIE
S SDTXT="VCL/VCP Wait List Clinic "_$$GET1^DIQ(409.32,SDWLCLS,.01)_" has been inactivated." D BMES^XPDUTL(SDTXT)
S ^TMP("SD793P",$J,"WLCLIN",SDCLN)=$$GET1^DIQ(409.32,SDWLCLS,.01)
Q
DISP(SDCLN) ;Disposition VCL/VCP entries on Wait List
N SDX,SDDSPDT,SDBY,SDDISP,SDCMT,SDSTAT,DA,DIE,DR,SDWLCLS
S SDX=0 F S SDX=$O(^SDWL(409.3,"SC",SDCLN,SDX)) Q:'SDX D
.S SDWLCLS=SDX_","
.I $G(^SDWL(409.3,SDX,"DIS")),$$GET1^DIQ(409.3,SDWLCLS,23,"I")="C" Q ;Quit if entry already dispositioned
.S SDDSPDT=DT,SDBY=.5,SDDISP="NN",SDCMT="Removed by patch SD*5.3*793 VCL/VCP WL Decom.",SDSTAT="C"
.S DIE="^SDWL(409.3,",DA=SDX,DR="23///^S X=SDSTAT;25///^S X=SDCMT" D ^DIE
.S DIE="^SDWL(409.3,",DA=SDX,DR="19///^S X=SDDSPDT;20///^S X=SDBY;21///^S X=SDDISP" D ^DIE
.S SDTXT="VCL/VCP Wait List entry number "_SDX_" has been dispositioned." D BMES^XPDUTL(SDTXT)
.S ^TMP("SD793P",$J,"DIS",SDX)=$$GET1^DIQ(409.3,SDWLCLS,.01)
Q
DISCLN ;Mailman Message of Inactivated Wait List Clinics
N DIFROM ;when invoking ^XMD in post-init routine of the KIDS build, the calling routine must NEW the DIFROM variable
N XMSUB,XMTEXT,XMY ;input vars for ^XMD call
N SDWLN,SDTEXT,SDLN,SDPT,SDTM,SDPOS,SDPOSS,SDTMS,SDTEAM,SDSPEC,SDSPECS,SDSPECTY,SDPOSIT ;local vars
;construct mailman msg
S XMSUB="SD*5.3*793 Post-Install - Inactive Clinics" ;msg subject
I $$GOTLOCAL^XMXAPIG("SD EWL BACKGROUND UPDATE") S XMY("G.SD EWL BACKGROUND UPDATE")="" ;send message to mail group
I '$$GOTLOCAL^XMXAPIG("SD EWL BACKGROUND UPDATE") S XMY($G(DUZ))="" ;msg addressee array
S XMTEXT="SDTEXT(" ;array containing the text of msg
S SDLN=1 ;msg line #
S SDTEXT(SDLN)="SD*5.3*793 Post-Install - Clinics Inactivated."
S SDLN=SDLN+1,SDTEXT(SDLN)="",SDLN=SDLN+1,SDTEXT(SDLN)="",SDLN=SDLN+1,SDTEXT(SDLN)=""
S SDTEXT(SDLN)="The Following VCL/VCP Clinics were inactivated by Patch SD*5.3*793.",SDLN=SDLN+1
S SDTEXT(SDLN)="CLINIC",SDLN=SDLN+1
S SDTEXT(SDLN)="----------------------------------------------------------",SDLN=SDLN+1
I '$D(^TMP("SD793P",$J,"CLIN")) S SDTEXT(SDLN)="No VCL/VCP Clinics were inactivated." D ^XMD Q
S SDCLN="" F S SDCLN=$O(^TMP("SD793P",$J,"CLIN",SDCLN)) Q:SDCLN="" D
.S SDLN=SDLN+1,SDTEXT(SDLN)=^TMP("SD793P",$J,"CLIN",SDCLN)
S SDLN=SDLN+1,SDTEXT(SDLN)="",SDLN=SDLN+1,SDTEXT(SDLN)="",SDLN=SDLN+1,SDTEXT(SDLN)=""
D ^XMD
Q
DISWL ;Mailman Message of Inactivated Wait List Clinics
N DIFROM ;when invoking ^XMD in post-init routine of the KIDS build, the calling routine must NEW the DIFROM variable
N XMSUB,XMTEXT,XMY ;input vars for ^XMD call
N SDWLN,SDTEXT,SDLN,SDPT,SDTM,SDPOS,SDPOSS,SDTMS,SDTEAM,SDSPEC,SDSPECS,SDSPECTY,SDPOSIT ;local vars
;construct mailman msg
S XMSUB="SD*5.3*793 Post-Install - Inactive WL Clinics" ;msg subject
I $$GOTLOCAL^XMXAPIG("SD EWL BACKGROUND UPDATE") S XMY("G.SD EWL BACKGROUND UPDATE")="" ;send message to mail group
I '$$GOTLOCAL^XMXAPIG("SD EWL BACKGROUND UPDATE") S XMY($G(DUZ))="" ;msg addressee array
S XMTEXT="SDTEXT(" ;array containing the text of msg
S SDLN=1 ;msg line #
S SDTEXT(SDLN)="SD*5.3*793 Post-Install - Inactive WL Clinics."
S SDLN=SDLN+1,SDTEXT(SDLN)="",SDLN=SDLN+1,SDTEXT(SDLN)="",SDLN=SDLN+1,SDTEXT(SDLN)=""
S SDTEXT(SDLN)="The Following VCL/VCP Wait List Clinics were inactivated by Patch SD*5.3*793.",SDLN=SDLN+1
S SDLN=SDLN+1,SDTEXT(SDLN)="WAIT LIST CLINIC",SDLN=SDLN+1
S SDLN=SDLN+1,SDTEXT(SDLN)="----------------------------------------------------------",SDLN=SDLN+1
I '$D(^TMP("SD793P",$J,"WLCLIN")) S SDTEXT(SDLN)="No Wait List Clinics were inactivated." D ^XMD Q
S SDTM=0 F S SDTM=$O(^TMP("SD793P",$J,"WLCLIN",SDTM)) Q:'SDTM D
.S SDLN=SDLN+1,SDTEXT(SDLN)=^TMP("SD793P",$J,"WLCLIN",SDTM)
S SDLN=SDLN+1,SDTEXT(SDLN)="",SDLN=SDLN+1
D ^XMD
Q
WLDIS ;Mailman Message of Dispositioned Wait List Entries
N DIFROM ;when invoking ^XMD in post-init routine of the KIDS build, the calling routine must NEW the DIFROM variable
N XMSUB,XMTEXT,XMY ;input vars for ^XMD call
N SDWLN,SDTEXT,SDLN,SDPT,SDTM,SDPOS,SDPOSS,SDTMS,SDTEAM,SDSPEC,SDSPECS,SDSPECTY,SDPOSIT ;local vars
;construct mailman msg
S XMSUB="SD*5.3*793 Post-Install - Dispositioned WL Entries" ;msg subject
I $$GOTLOCAL^XMXAPIG("SD EWL BACKGROUND UPDATE") S XMY("G.SD EWL BACKGROUND UPDATE")="" ;send message to mail group
I '$$GOTLOCAL^XMXAPIG("SD EWL BACKGROUND UPDATE") S XMY($G(DUZ))="" ;msg addressee array
S XMTEXT="SDTEXT(" ;array containing the text of msg
S SDLN=1 ;msg line #
S SDTEXT(SDLN)="SD*5.3*793 Post-Install - Dispositioned WL Entries."
S SDLN=SDLN+1,SDTEXT(SDLN)="",SDLN=SDLN+1,SDTEXT(SDLN)="",SDLN=SDLN+1,SDTEXT(SDLN)=""
S SDTEXT(SDLN)="The Following VCL/VCP Wait List entries were dispositioned by Patch SD*5.3*793.",SDLN=SDLN+1
S SDLN=SDLN+1,SDTEXT(SDLN)="WAIT LIST IEN - PATIENT",SDLN=SDLN+1
S SDLN=SDLN+1,SDTEXT(SDLN)="----------------------------------------------------------",SDLN=SDLN+1
I '$D(^TMP("SD793P",$J,"DIS")) S SDTEXT(SDLN)="No Wait List Entries were Dispositioned." D ^XMD Q
S SDPOS=0 F S SDPOS=$O(^TMP("SD793P",$J,"DIS",SDPOS)) Q:'SDPOS D
.S SDLN=SDLN+1,SDTEXT(SDLN)=SDPOS_" - "_^TMP("SD793P",$J,"DIS",SDPOS)
S SDLN=SDLN+1,SDTEXT(SDLN)=""
D ^XMD
Q
SDWLCHK ;Run through remaining SD Wait List entries and Disposition any linked to inactive clinics
N SDWL,SDWLCL,SDDSPDT,SDBY,SDDISP,SDCMT,SDSTAT,DIE,DA,DR,SDTXT
S SDWL=0 F S SDWL=$O(^SDWL(409.3,SDWL)) Q:'SDWL I $$GET1^DIQ(409.3,SDWL,23,"I")="O" D
.S SDWLCL=$$GET1^DIQ(409.3,SDWL,8,"I") I SDWLCL S SDWLCLN=$$GET1^DIQ(409.32,SDWLCL,.01) I SDWLCLN["VCL"!(SDWLCLN["VCP") D
..I $$GET1^DIQ(409.32,SDWLCL,3,"I") D
...S SDDSPDT=DT,SDBY=.5,SDDISP="NN",SDCMT="Removed by patch SD*5.3*793 VCL/VCP WL Decom.",SDSTAT="C"
...S DIE="^SDWL(409.3,",DA=SDWL,DR="23///^S X=SDSTAT;25///^S X=SDCMT" D ^DIE
...S DIE="^SDWL(409.3,",DA=SDWL,DR="19///^S X=SDDSPDT;20///^S X=SDBY;21///^S X=SDDISP" D ^DIE
...S SDTXT="VCL/VCP Wait List entry number "_SDWL_" has been dispositioned." D BMES^XPDUTL(SDTXT)
...S ^TMP("SD793P",$J,"DIS",SDWL)=$$GET1^DIQ(409.3,SDWL,.01)
Q
VCLOPEN ;Mailman Message of Clinics with pending future appointments
N DIFROM ;when invoking ^XMD in post-init routine of the KIDS build, the calling routine must NEW the DIFROM variable
N XMSUB,XMTEXT,XMY ;input vars for ^XMD call
N SDWLN,SDTEXT,SDLN,SDPT,SDTM,SDPOS,SDPOSS,SDTMS,SDTEAM,SDSPEC,SDSPECS,SDSPECTY,SDPOSIT ;local vars
;construct mailman msg
S XMSUB="SD*5.3*793 Post-Install - VCL/VCP Clinics w/ Future Appts" ;msg subject
I $$GOTLOCAL^XMXAPIG("SD EWL BACKGROUND UPDATE") S XMY("G.SD EWL BACKGROUND UPDATE")="" ;send message to mail group
I '$$GOTLOCAL^XMXAPIG("SD EWL BACKGROUND UPDATE") S XMY($G(DUZ))="" ;msg addressee array
S XMTEXT="SDTEXT(" ;array containing the text of msg
S SDLN=1 ;msg line #
S SDTEXT(SDLN)="SD*5.3*793 Post-Install - VCL/VCP Clinics w/ Future Appts."
S SDLN=SDLN+1,SDTEXT(SDLN)="",SDLN=SDLN+1,SDTEXT(SDLN)="",SDLN=SDLN+1,SDTEXT(SDLN)=""
S SDTEXT(SDLN)="***The Following VCL/VCP Clinics were not inactivated by SD*5.3*793 due to future patient appointments being scheduled.***",SDLN=SDLN+1
S SDTEXT(SDLN)="",SDLN=SDLN+1
S SDTEXT(SDLN)="***If this is not a VCL/VCP clinic, no action is needed.***",SDLN=SDLN+1
S SDTEXT(SDLN)="",SDLN=SDLN+1
S SDTEXT(SDLN)="***If this is a VCL/VCP clinic, the appointments should be canceled and moved to a non VCL/VCP clinics.***",SDLN=SDLN+1
S SDTEXT(SDLN)="",SDLN=SDLN+1
S SDLN=SDLN+1,SDTEXT(SDLN)="VCL/VCP CLINIC",SDLN=SDLN+1
S SDLN=SDLN+1,SDTEXT(SDLN)="----------------------------------------------------------",SDLN=SDLN+1
I '$D(^TMP("SD793P",$J,"OPEN")) S SDTEXT(SDLN)="Any active VCL/VCP were inactivated" D ^XMD Q
S SDPOS=0 F S SDPOS=$O(^TMP("SD793P",$J,"OPEN",SDPOS)) Q:'SDPOS D
.S SDLN=SDLN+1,SDTEXT(SDLN)=^TMP("SD793P",$J,"OPEN",SDPOS)
S SDLN=SDLN+1,SDTEXT(SDLN)=""
D ^XMD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSD53793P 11046 printed Apr 09, 2024@22:02:46 Page 2
SD53793P ;MNT/BJR - Inactivate VCL/VCP Clinics ; Aug 03, 2021@07:22
+1 ;;5.3;Scheduling;**793**;Aug 13, 1993;Build 9
+2 ;
+3 QUIT
+4 ;References to DELETE^XPDPROT in ICR #5567
+5 ;References to OUT^XPDPROT in ICR #5567
+6 ;References to OUT^XPDMENU in ICR #1157
+7 ;References to BMES^XPDUTL in ICR #10141
+8 ;References to XREF^XQORM in ICR #10140
+9 ;References to GET1^DIQ in ICR #2056
+10 ;References to GOTLOCAL^XMXAPIG in ICR #3006
+11 ;References to ^XMD in ICR #10070
+12 ;References to ^DIE in ICR #10013
+13 ;References to file 40.8 in ICR #2295
+14 ;
+15 ;Post-init routine for EWL Decommission
+16 ;
+17 ;
EN ;Entry point for SD*5.3*793 Post Install routine
+1 KILL ^TMP("SD793P",$JOB)
+2 DO INACLN
+3 DO DISCLN
+4 DO DISWL
+5 DO WLDIS
+6 DO SDWLCHK
+7 DO VCLOPEN
+8 KILL ^TMP("SD793P",$JOB)
+9 QUIT
INACLN ;Inactivate VCL/VCP clinics
+1 NEW SDCLN,SDCLNS,SDWLCLN,DR,DA,DIE,DIK,SDTXT,SDCLIEN,SDDATE,SDI,SDX1,SDZZNM,SDFLG,SDAPPT,SDNUM,SDINST,SDDIV,SDT
+2 SET SDCLN=0
FOR
SET SDCLN=$ORDER(^SC(SDCLN))
if 'SDCLN
QUIT
Begin DoDot:1
+3 SET SDFLG=0
+4 SET SDCLNS=SDCLN_","
SET SDX1=9999999
+5 SET SDDATE=$PIECE($$NOW^XLFDT,".")
+6 SET SDWLCLN=$ORDER(^SDWL(409.32,"B",SDCLN,""))
+7 IF $$GET1^DIQ(44,SDCLNS,.01)["VCL"!($$GET1^DIQ(44,SDCLNS,.01)["VCP")
SET SDFLG=1
+8 if 'SDFLG
QUIT
+9 if ($$GET1^DIQ(44,SDCLNS,8)'="COMMUNITY CARE CONSULT")
QUIT
+10 SET SDAPPT=DT
FOR
SET SDAPPT=$ORDER(^SC(SDCLN,"S",SDAPPT))
if 'SDAPPT
QUIT
Begin DoDot:2
+11 SET SDNUM=0
FOR
SET SDNUM=$ORDER(^SC(SDCLN,"S",SDAPPT,1,SDNUM))
if 'SDNUM
QUIT
IF $PIECE($GET(^SC(SDCLN,"S",SDAPPT,1,SDNUM,0)),U,9)=""
SET SDFLG=0
Begin DoDot:3
+12 SET ^TMP("SD793P",$JOB,"OPEN",SDCLN)=$$GET1^DIQ(44,SDCLNS,.01)
End DoDot:3
End DoDot:2
+13 if 'SDFLG
QUIT
+14 SET SDINST=$$GET1^DIQ(44,SDCLNS,3)
IF SDINST=""
SET SDDIV=$$GET1^DIQ(44,SDCLNS,3.5,"I")
SET SDINST=$$GET1^DIQ(40.8,SDDIV,.07)
+15 IF SDWLCLN
DO INACTWL(SDWLCLN)
DO DISP(SDCLN)
+16 IF $PIECE($GET(^SC(SDCLN,"I")),U)'=""
IF $PIECE($GET(^SC(SDCLN,"I")),U,2)=""
QUIT
+17 SET SDZZNM="ZZ"_$EXTRACT($$GET1^DIQ(44,SDCLNS,.01),1,28)
+18 SET DR=".01///^S X=SDZZNM;2505///^S X=DT;2506///@"
SET DIE="^SC("
SET DA=SDCLN
DO ^DIE
+19 FOR SDI=SDDATE-.0001:0
SET SDI=$ORDER(^SC(SDCLN,"ST",SDI))
if 'SDI!(SDI>SDX1)
QUIT
SET DA=SDI
SET DA(1)=SDCLN
SET DIK="^SC(SDCLN,""ST"","
DO ^DIK
+20 FOR SDI=SDDATE-.0001:0
SET SDI=$ORDER(^SC(SDCLN,"T",SDI))
if 'SDI!(SDI>SDX1)
QUIT
SET DA=SDI
SET DA(1)=SDCLN
SET DIK="^SC(SDCLN,""T"","
DO ^DIK
+21 FOR SDI=SDDATE-.0001:0
SET SDI=$ORDER(^SC(SDCLN,"OST",SDI))
if 'SDI!(SDI>SDX1)
QUIT
SET DA=SDI
SET DA(1)=SDCLN
SET DIK="^SC(SDCLN,""OST"","
DO ^DIK
+22 FOR SDI=0:1:6
SET SDT="T"_SDI
IF $DATA(^SC(SDCLN,SDT,9999999))
SET ^SC(SDCLN,SDT,DT,0)=DT
SET ^SC(SDCLN,SDT,DT,1)=^SC(SDCLN,SDT,9999999,1)
SET ^SC(SDCLN,SDT,9999999,1)=""
+23 DO SDEC^SDNACT(SDCLN,DT)
+24 SET SDTXT="VCL/VCP Clinic "_$$GET1^DIQ(44,SDCLNS,.01)_" has been inactivated."
DO BMES^XPDUTL(SDTXT)
+25 SET ^TMP("SD793P",$JOB,"CLIN",SDCLN)=$$GET1^DIQ(44,SDCLNS,.01)
End DoDot:1
+26 QUIT
INACTWL(SDWLCLN) ;Inactivate SDWL Clinic
+1 NEW SDWLCLS,SDTXT,DR,DA,DIE
+2 ;Quit if already inactivated
if $PIECE(^SDWL(409.32,SDWLCLN,0),U,4)
QUIT
+3 SET SDWLCLS=SDWLCLN_","
+4 ;File missing institution to avoid Fileman error
IF $PIECE(^SDWL(409.32,SDWLCLN,0),U,6)=""
SET DR=".02///^S X=SDINST"
SET DIE="^SDWL(409.32,"
SET DA=SDWLCLN
DO ^DIE
+5 IF $PIECE(^SDWL(409.32,SDWLCLN,0),U,6)=""
SET SDTXT="VCL/VCP Wait List Clinic "_$$GET1^DIQ(409.32,SDWLCLS,.01)_" is missing required Institution and cannot be inactivated."
DO BMES^XPDUTL(SDTXT)
QUIT
+6 SET DR="3///^S X=DT;4///^S X=.5"
SET DIE="^SDWL(409.32,"
SET DA=SDWLCLN
DO ^DIE
+7 SET SDTXT="VCL/VCP Wait List Clinic "_$$GET1^DIQ(409.32,SDWLCLS,.01)_" has been inactivated."
DO BMES^XPDUTL(SDTXT)
+8 SET ^TMP("SD793P",$JOB,"WLCLIN",SDCLN)=$$GET1^DIQ(409.32,SDWLCLS,.01)
+9 QUIT
DISP(SDCLN) ;Disposition VCL/VCP entries on Wait List
+1 NEW SDX,SDDSPDT,SDBY,SDDISP,SDCMT,SDSTAT,DA,DIE,DR,SDWLCLS
+2 SET SDX=0
FOR
SET SDX=$ORDER(^SDWL(409.3,"SC",SDCLN,SDX))
if 'SDX
QUIT
Begin DoDot:1
+3 SET SDWLCLS=SDX_","
+4 ;Quit if entry already dispositioned
IF $GET(^SDWL(409.3,SDX,"DIS"))
IF $$GET1^DIQ(409.3,SDWLCLS,23,"I")="C"
QUIT
+5 SET SDDSPDT=DT
SET SDBY=.5
SET SDDISP="NN"
SET SDCMT="Removed by patch SD*5.3*793 VCL/VCP WL Decom."
SET SDSTAT="C"
+6 SET DIE="^SDWL(409.3,"
SET DA=SDX
SET DR="23///^S X=SDSTAT;25///^S X=SDCMT"
DO ^DIE
+7 SET DIE="^SDWL(409.3,"
SET DA=SDX
SET DR="19///^S X=SDDSPDT;20///^S X=SDBY;21///^S X=SDDISP"
DO ^DIE
+8 SET SDTXT="VCL/VCP Wait List entry number "_SDX_" has been dispositioned."
DO BMES^XPDUTL(SDTXT)
+9 SET ^TMP("SD793P",$JOB,"DIS",SDX)=$$GET1^DIQ(409.3,SDWLCLS,.01)
End DoDot:1
+10 QUIT
DISCLN ;Mailman Message of Inactivated Wait List Clinics
+1 ;when invoking ^XMD in post-init routine of the KIDS build, the calling routine must NEW the DIFROM variable
NEW DIFROM
+2 ;input vars for ^XMD call
NEW XMSUB,XMTEXT,XMY
+3 ;local vars
NEW SDWLN,SDTEXT,SDLN,SDPT,SDTM,SDPOS,SDPOSS,SDTMS,SDTEAM,SDSPEC,SDSPECS,SDSPECTY,SDPOSIT
+4 ;construct mailman msg
+5 ;msg subject
SET XMSUB="SD*5.3*793 Post-Install - Inactive Clinics"
+6 ;send message to mail group
IF $$GOTLOCAL^XMXAPIG("SD EWL BACKGROUND UPDATE")
SET XMY("G.SD EWL BACKGROUND UPDATE")=""
+7 ;msg addressee array
IF '$$GOTLOCAL^XMXAPIG("SD EWL BACKGROUND UPDATE")
SET XMY($GET(DUZ))=""
+8 ;array containing the text of msg
SET XMTEXT="SDTEXT("
+9 ;msg line #
SET SDLN=1
+10 SET SDTEXT(SDLN)="SD*5.3*793 Post-Install - Clinics Inactivated."
+11 SET SDLN=SDLN+1
SET SDTEXT(SDLN)=""
SET SDLN=SDLN+1
SET SDTEXT(SDLN)=""
SET SDLN=SDLN+1
SET SDTEXT(SDLN)=""
+12 SET SDTEXT(SDLN)="The Following VCL/VCP Clinics were inactivated by Patch SD*5.3*793."
SET SDLN=SDLN+1
+13 SET SDTEXT(SDLN)="CLINIC"
SET SDLN=SDLN+1
+14 SET SDTEXT(SDLN)="----------------------------------------------------------"
SET SDLN=SDLN+1
+15 IF '$DATA(^TMP("SD793P",$JOB,"CLIN"))
SET SDTEXT(SDLN)="No VCL/VCP Clinics were inactivated."
DO ^XMD
QUIT
+16 SET SDCLN=""
FOR
SET SDCLN=$ORDER(^TMP("SD793P",$JOB,"CLIN",SDCLN))
if SDCLN=""
QUIT
Begin DoDot:1
+17 SET SDLN=SDLN+1
SET SDTEXT(SDLN)=^TMP("SD793P",$JOB,"CLIN",SDCLN)
End DoDot:1
+18 SET SDLN=SDLN+1
SET SDTEXT(SDLN)=""
SET SDLN=SDLN+1
SET SDTEXT(SDLN)=""
SET SDLN=SDLN+1
SET SDTEXT(SDLN)=""
+19 DO ^XMD
+20 QUIT
DISWL ;Mailman Message of Inactivated Wait List Clinics
+1 ;when invoking ^XMD in post-init routine of the KIDS build, the calling routine must NEW the DIFROM variable
NEW DIFROM
+2 ;input vars for ^XMD call
NEW XMSUB,XMTEXT,XMY
+3 ;local vars
NEW SDWLN,SDTEXT,SDLN,SDPT,SDTM,SDPOS,SDPOSS,SDTMS,SDTEAM,SDSPEC,SDSPECS,SDSPECTY,SDPOSIT
+4 ;construct mailman msg
+5 ;msg subject
SET XMSUB="SD*5.3*793 Post-Install - Inactive WL Clinics"
+6 ;send message to mail group
IF $$GOTLOCAL^XMXAPIG("SD EWL BACKGROUND UPDATE")
SET XMY("G.SD EWL BACKGROUND UPDATE")=""
+7 ;msg addressee array
IF '$$GOTLOCAL^XMXAPIG("SD EWL BACKGROUND UPDATE")
SET XMY($GET(DUZ))=""
+8 ;array containing the text of msg
SET XMTEXT="SDTEXT("
+9 ;msg line #
SET SDLN=1
+10 SET SDTEXT(SDLN)="SD*5.3*793 Post-Install - Inactive WL Clinics."
+11 SET SDLN=SDLN+1
SET SDTEXT(SDLN)=""
SET SDLN=SDLN+1
SET SDTEXT(SDLN)=""
SET SDLN=SDLN+1
SET SDTEXT(SDLN)=""
+12 SET SDTEXT(SDLN)="The Following VCL/VCP Wait List Clinics were inactivated by Patch SD*5.3*793."
SET SDLN=SDLN+1
+13 SET SDLN=SDLN+1
SET SDTEXT(SDLN)="WAIT LIST CLINIC"
SET SDLN=SDLN+1
+14 SET SDLN=SDLN+1
SET SDTEXT(SDLN)="----------------------------------------------------------"
SET SDLN=SDLN+1
+15 IF '$DATA(^TMP("SD793P",$JOB,"WLCLIN"))
SET SDTEXT(SDLN)="No Wait List Clinics were inactivated."
DO ^XMD
QUIT
+16 SET SDTM=0
FOR
SET SDTM=$ORDER(^TMP("SD793P",$JOB,"WLCLIN",SDTM))
if 'SDTM
QUIT
Begin DoDot:1
+17 SET SDLN=SDLN+1
SET SDTEXT(SDLN)=^TMP("SD793P",$JOB,"WLCLIN",SDTM)
End DoDot:1
+18 SET SDLN=SDLN+1
SET SDTEXT(SDLN)=""
SET SDLN=SDLN+1
+19 DO ^XMD
+20 QUIT
WLDIS ;Mailman Message of Dispositioned Wait List Entries
+1 ;when invoking ^XMD in post-init routine of the KIDS build, the calling routine must NEW the DIFROM variable
NEW DIFROM
+2 ;input vars for ^XMD call
NEW XMSUB,XMTEXT,XMY
+3 ;local vars
NEW SDWLN,SDTEXT,SDLN,SDPT,SDTM,SDPOS,SDPOSS,SDTMS,SDTEAM,SDSPEC,SDSPECS,SDSPECTY,SDPOSIT
+4 ;construct mailman msg
+5 ;msg subject
SET XMSUB="SD*5.3*793 Post-Install - Dispositioned WL Entries"
+6 ;send message to mail group
IF $$GOTLOCAL^XMXAPIG("SD EWL BACKGROUND UPDATE")
SET XMY("G.SD EWL BACKGROUND UPDATE")=""
+7 ;msg addressee array
IF '$$GOTLOCAL^XMXAPIG("SD EWL BACKGROUND UPDATE")
SET XMY($GET(DUZ))=""
+8 ;array containing the text of msg
SET XMTEXT="SDTEXT("
+9 ;msg line #
SET SDLN=1
+10 SET SDTEXT(SDLN)="SD*5.3*793 Post-Install - Dispositioned WL Entries."
+11 SET SDLN=SDLN+1
SET SDTEXT(SDLN)=""
SET SDLN=SDLN+1
SET SDTEXT(SDLN)=""
SET SDLN=SDLN+1
SET SDTEXT(SDLN)=""
+12 SET SDTEXT(SDLN)="The Following VCL/VCP Wait List entries were dispositioned by Patch SD*5.3*793."
SET SDLN=SDLN+1
+13 SET SDLN=SDLN+1
SET SDTEXT(SDLN)="WAIT LIST IEN - PATIENT"
SET SDLN=SDLN+1
+14 SET SDLN=SDLN+1
SET SDTEXT(SDLN)="----------------------------------------------------------"
SET SDLN=SDLN+1
+15 IF '$DATA(^TMP("SD793P",$JOB,"DIS"))
SET SDTEXT(SDLN)="No Wait List Entries were Dispositioned."
DO ^XMD
QUIT
+16 SET SDPOS=0
FOR
SET SDPOS=$ORDER(^TMP("SD793P",$JOB,"DIS",SDPOS))
if 'SDPOS
QUIT
Begin DoDot:1
+17 SET SDLN=SDLN+1
SET SDTEXT(SDLN)=SDPOS_" - "_^TMP("SD793P",$JOB,"DIS",SDPOS)
End DoDot:1
+18 SET SDLN=SDLN+1
SET SDTEXT(SDLN)=""
+19 DO ^XMD
+20 QUIT
SDWLCHK ;Run through remaining SD Wait List entries and Disposition any linked to inactive clinics
+1 NEW SDWL,SDWLCL,SDDSPDT,SDBY,SDDISP,SDCMT,SDSTAT,DIE,DA,DR,SDTXT
+2 SET SDWL=0
FOR
SET SDWL=$ORDER(^SDWL(409.3,SDWL))
if 'SDWL
QUIT
IF $$GET1^DIQ(409.3,SDWL,23,"I")="O"
Begin DoDot:1
+3 SET SDWLCL=$$GET1^DIQ(409.3,SDWL,8,"I")
IF SDWLCL
SET SDWLCLN=$$GET1^DIQ(409.32,SDWLCL,.01)
IF SDWLCLN["VCL"!(SDWLCLN["VCP")
Begin DoDot:2
+4 IF $$GET1^DIQ(409.32,SDWLCL,3,"I")
Begin DoDot:3
+5 SET SDDSPDT=DT
SET SDBY=.5
SET SDDISP="NN"
SET SDCMT="Removed by patch SD*5.3*793 VCL/VCP WL Decom."
SET SDSTAT="C"
+6 SET DIE="^SDWL(409.3,"
SET DA=SDWL
SET DR="23///^S X=SDSTAT;25///^S X=SDCMT"
DO ^DIE
+7 SET DIE="^SDWL(409.3,"
SET DA=SDWL
SET DR="19///^S X=SDDSPDT;20///^S X=SDBY;21///^S X=SDDISP"
DO ^DIE
+8 SET SDTXT="VCL/VCP Wait List entry number "_SDWL_" has been dispositioned."
DO BMES^XPDUTL(SDTXT)
+9 SET ^TMP("SD793P",$JOB,"DIS",SDWL)=$$GET1^DIQ(409.3,SDWL,.01)
End DoDot:3
End DoDot:2
End DoDot:1
+10 QUIT
VCLOPEN ;Mailman Message of Clinics with pending future appointments
+1 ;when invoking ^XMD in post-init routine of the KIDS build, the calling routine must NEW the DIFROM variable
NEW DIFROM
+2 ;input vars for ^XMD call
NEW XMSUB,XMTEXT,XMY
+3 ;local vars
NEW SDWLN,SDTEXT,SDLN,SDPT,SDTM,SDPOS,SDPOSS,SDTMS,SDTEAM,SDSPEC,SDSPECS,SDSPECTY,SDPOSIT
+4 ;construct mailman msg
+5 ;msg subject
SET XMSUB="SD*5.3*793 Post-Install - VCL/VCP Clinics w/ Future Appts"
+6 ;send message to mail group
IF $$GOTLOCAL^XMXAPIG("SD EWL BACKGROUND UPDATE")
SET XMY("G.SD EWL BACKGROUND UPDATE")=""
+7 ;msg addressee array
IF '$$GOTLOCAL^XMXAPIG("SD EWL BACKGROUND UPDATE")
SET XMY($GET(DUZ))=""
+8 ;array containing the text of msg
SET XMTEXT="SDTEXT("
+9 ;msg line #
SET SDLN=1
+10 SET SDTEXT(SDLN)="SD*5.3*793 Post-Install - VCL/VCP Clinics w/ Future Appts."
+11 SET SDLN=SDLN+1
SET SDTEXT(SDLN)=""
SET SDLN=SDLN+1
SET SDTEXT(SDLN)=""
SET SDLN=SDLN+1
SET SDTEXT(SDLN)=""
+12 SET SDTEXT(SDLN)="***The Following VCL/VCP Clinics were not inactivated by SD*5.3*793 due to future patient appointments being scheduled.***"
SET SDLN=SDLN+1
+13 SET SDTEXT(SDLN)=""
SET SDLN=SDLN+1
+14 SET SDTEXT(SDLN)="***If this is not a VCL/VCP clinic, no action is needed.***"
SET SDLN=SDLN+1
+15 SET SDTEXT(SDLN)=""
SET SDLN=SDLN+1
+16 SET SDTEXT(SDLN)="***If this is a VCL/VCP clinic, the appointments should be canceled and moved to a non VCL/VCP clinics.***"
SET SDLN=SDLN+1
+17 SET SDTEXT(SDLN)=""
SET SDLN=SDLN+1
+18 SET SDLN=SDLN+1
SET SDTEXT(SDLN)="VCL/VCP CLINIC"
SET SDLN=SDLN+1
+19 SET SDLN=SDLN+1
SET SDTEXT(SDLN)="----------------------------------------------------------"
SET SDLN=SDLN+1
+20 IF '$DATA(^TMP("SD793P",$JOB,"OPEN"))
SET SDTEXT(SDLN)="Any active VCL/VCP were inactivated"
DO ^XMD
QUIT
+21 SET SDPOS=0
FOR
SET SDPOS=$ORDER(^TMP("SD793P",$JOB,"OPEN",SDPOS))
if 'SDPOS
QUIT
Begin DoDot:1
+22 SET SDLN=SDLN+1
SET SDTEXT(SDLN)=^TMP("SD793P",$JOB,"OPEN",SDPOS)
End DoDot:1
+23 SET SDLN=SDLN+1
SET SDTEXT(SDLN)=""
+24 DO ^XMD
+25 QUIT
