SD53769P ;MNT/BJR - MARK EWL OPT/PROT OOO ;Oct 05, 2021@08:58
;;5.3;Scheduling;**769**;Aug 13, 1993;Build 22
;
Q
;References to DELETE^XPDPROT supported by DBIA #5567
;References to OUT^XPDPROT supported by DBIA #5567
;References to OUT^XPDMENU supported by DBIA #1157
;References to BMES^XPDUTL supported by DBIA #10141
;References to XREF^XQORM supported by DBIA #10140
;References to GET1^DIQ supported by DBIA #2056
;References to GOTLOCAL^XMXAPIG supported by DBIA #3006
;References to ^XMD supported by DBIA #10070
;References to ^DIE supported by DBIA #10018
;
;Post-init routine for EWL Decommission
;
;
EN ;Entry point for SD*5.3*769 Post Install routine
D DELPROT
D DISPROT
D DISOPT
D CHKCLN
D DISPAT
D CHKCLN
D INACLN
D DISCLN
Q
DELPROT ;Delete Protocol from List Protocol
N SDOM,SDMN,SDPROT,SDCHK,SDOP,SDTEXT,XQORM
F SDOM=1:1 S SDMN=$P($TEXT(MENLST+SDOM),";;",2) Q:SDMN="$$END" D
.F SDOP=1:1 S SDPROT=$P($TEXT(PROLST+SDOP),";;",2) Q:SDPROT="$$END" D
..S SDCHK=$$DELETE^XPDPROT(SDMN,SDPROT)
..I SDCHK S SDTEXT="The "_SDPROT_" protocol has been deleted from the "_SDMN_" protocol menu." D BMES^XPDUTL(SDTEXT)
..I 'SDCHK S SDTEXT="The "_SDPROT_" protocol could not be deleted from the "_SDMN_" protocol menu. It may have already been removed." D BMES^XPDUTL(SDTEXT)
S XQORM=$O(^ORD(101,"B","SDAM MENU",0))_";ORD(101,"
D XREF^XQORM ;Force protocol recompile.
Q
;
DISPROT ;Disable Protocols
N SDPRTL,SDPR,SDTEXT
F SDPR=1:1 S SDPRTL=$P($TEXT(DISLST+SDPR),";;",2) Q:SDPRTL="$$END" D
.D OUT^XPDPROT(SDPRTL,"DO NOT USE!! - EWL DECOM - SD*5.3*769")
.S SDTEXT="The "_SDPRTL_" protocol has been disabled." D BMES^XPDUTL(SDTEXT)
Q
DISOPT ;Mark Options OOO
N SDOPT,SDCNT,SDTEXT
F SDCNT=1:1 S SDOPT=$P($TEXT(OPTLST+SDCNT),";;",2) Q:SDOPT="$$END" D
.D OUT^XPDMENU(SDOPT,"DO NOT USE!! - EWL DECOM - SD*5.3*769")
.S SDTEXT="The "_SDOPT_" option has been marked out of order." D BMES^XPDUTL(SDTEXT)
Q
CHKCLN ;Check wait list clinics for active appointments
N SDCLN,SDCLNS,SDWLSCN,SDWLCNT,SDWLN
K ^TMP("SD769P",$J)
S SDCLN=0 F S SDCLN=$O(^SDWL(409.32,SDCLN)) Q:'SDCLN D
.S SDCLNS=SDCLN_","
.Q:($P(^SDWL(409.32,SDCLN,0),U,4))
.Q:($$GET1^DIQ(409.32,SDCLNS,.01)["VCL")
.S SDCLNS=SDCLN_"," S SDWLSCN=$P($G(^SDWL(409.32,SDCLN,0)),U,1)
.I $D(^SDWL(409.3,"SC",SDWLSCN))&'$P($G(^SDWL(409.32,SDCLN,0)),U,4) D
..S SDWLN="",SDWLCNT=0 F S SDWLN=$O(^SDWL(409.3,"SC",SDWLSCN,SDWLN)) Q:SDWLN="" D
...I '$D(^SDWL(409.3,SDWLN,"DIS")) S ^TMP("SD769P",$J,"DIS",SDWLSCN,SDWLN)=""
Q
DISPAT ;Remove entries without patient info
N SDWLN,SDCNT,SDPAT,SDCLN,SDIEN,SDTM,SDPOS,SDSPL,DA,DIE,DR,SDWLCL
S SDWLCL=0 F S SDWLCL=$O(^TMP("SD769P",$J,"DIS",SDWLCL)) Q:'SDWLCL D
.S SDWLN=0 F S SDWLN=$O(^TMP("SD769P",$J,"DIS",SDWLCL,SDWLN)) Q:'SDWLN D
..S SDPAT=$$GET1^DIQ(409.3,SDWLN,.01),SDCLN=$$GET1^DIQ(409.3,SDWLN,8),SDIEN=SDWLN
..S SDTM=$$GET1^DIQ(409.3,SDWLN,5),SDPOS=$$GET1^DIQ(409.3,SDWLN,6),SDSPL=$$GET1^DIQ(409.3,SDWLN,7)
..I SDPAT="",SDTM="",SDPOS="",SDSPL="" D
...S $P(^SDWL(409.3,SDWLN,0),U)=0,DA=SDIEN,DIK="^SDWL(409.3," D ^DIK
...S SDTXT="Wait List Entry number "_SDIEN_" with no patient info has been deleted." D BMES^XPDUTL(SDTXT)
Q
INACLN ;Inactivate wait list clinics without active appointments
N SDCLN,SDCLNS,SDWLSCN,SDWLCNT,SDWLN,SDWLSTOP,SDX,DR,DA,DIE,SDTXT
K ^TMP("SD769P",$J)
S SDCLN=0 F S SDCLN=$O(^SDWL(409.32,SDCLN)) Q:'SDCLN D
.S SDCLNS=SDCLN_","
.Q:($P(^SDWL(409.32,SDCLN,0),U,4))'=""
.Q:($$GET1^DIQ(409.32,SDCLNS,.01)["VCL")
.S SDCLNS=SDCLN_",",SDWLSCN=$P($G(^SDWL(409.32,SDCLN,0)),U,1),SDWLSTOP=0
.I $D(^SDWL(409.3,"SC",SDWLSCN))&'$P($G(^SDWL(409.32,SDCLN,0)),U,4) D
..S SDWLN="",SDWLCNT=0 F S SDWLN=$O(^SDWL(409.3,"SC",SDWLSCN,SDWLN)) Q:SDWLN="" D
...S SDX=$G(^SDWL(409.3,SDWLN,0)) I '$D(^SDWL(409.3,SDWLN,"DIS")) S ^TMP("SD769P",$J,"DIS",SDWLN)="",SDWLSTOP=1
.I SDWLSTOP S SDTEXT="Clinic "_$$GET1^DIQ(409.32,SDCLNS,.01)_" has Patients on the Wait List and cannot be inactivated." D BMES^XPDUTL(SDTEXT) Q
.S DR="3///^S X=DT;4///^S X=.5",DIE="^SDWL(409.32,",DA=SDCLN D ^DIE
.S SDTXT="Wait List Clinic "_$$GET1^DIQ(409.32,SDCLNS,.01)_" has been inactivated." D BMES^XPDUTL(SDTXT)
Q
LSTOTH ;List active Wait List entries not clinic specific
N SDPAT,SDCLN,SDIEN,SDTM,SDPOS,SDSPL
S SDIEN=0 F S SDIEN=$O(^SDWL(409.3,SDIEN)) Q:'SDIEN D
.Q:$P(^SDWL(409.3,SDIEN,0),U,8)'="" ;Quit if Clinic exists
.Q:$D(^SDWL(409.3,SDIEN,"DIS")) ;Quit if Dispositioned
.I $P(^SDWL(409.3,SDIEN,0),U,5)'="" S ^TMP("SD769P",$J,"TEAM",SDIEN)="" Q
.I $P(^SDWL(409.3,SDIEN,0),U,6)'="" S ^TMP("SD769P",$J,"POS",SDIEN)="" Q
.I $P(^SDWL(409.3,SDIEN,0),U,7)'="" S ^TMP("SD769P",$J,"SPEC",SDIEN)="" Q
Q
DISCLN ;
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*769 Post-Install Job Results" ;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*769 post-install job results."
S SDLN=2
S SDTEXT(SDLN)="The Following Wait List Entries need to be scheduled for the following patients.",SDLN=SDLN+1
S SDTEXT(SDLN)="PATIENT CLINIC",SDLN=SDLN+1
S SDTEXT(SDLN)="----------------------------------------------------------",SDLN=SDLN+1
S SDWLN=0 F S SDWLN=$O(^TMP("SD769P",$J,"DIS",SDWLN)) Q:'SDWLN D
.S SDCLNS=SDWLN_"," S SDWLSCN=$$GET1^DIQ(409.3,SDCLNS,8),SDPT=$$GET1^DIQ(409.3,SDCLNS,.01)
.S SDPT=SDPT_" ",SDPT=$E(SDPT,1,31)
.S SDLN=SDLN+1,SDTEXT(SDLN)=SDPT_SDWLSCN
S SDLN=SDLN+1,SDTEXT(SDLN)=""
S SDLN=SDLN+1,SDTEXT(SDLN)="PATIENT TEAM",SDLN=SDLN+1
S SDLN=SDLN+1,SDTEXT(SDLN)="----------------------------------------------------------",SDLN=SDLN+1
S SDTM=0 F S SDTM=$O(^TMP("SD769P",$J,"TEAM",SDTM)) Q:'SDTM D
.S SDTMS=SDTM_"," S SDTEAM=$$GET1^DIQ(409.3,SDTMS,5),SDPT=$$GET1^DIQ(409.3,SDTMS,.01)
.S SDPT=SDPT_" ",SDPT=$E(SDPT,1,31)
.S SDLN=SDLN+1,SDTEXT(SDLN)=SDPT_SDTEAM
S SDLN=SDLN+1,SDTEXT(SDLN)=""
S SDLN=SDLN+1,SDTEXT(SDLN)="PATIENT POSITION",SDLN=SDLN+1
S SDLN=SDLN+1,SDTEXT(SDLN)="----------------------------------------------------------",SDLN=SDLN+1
S SDPOS=0 F S SDPOS=$O(^TMP("SD769P",$J,"POS",SDPOS)) Q:'SDPOS D
.S SDPOSS=SDPOS_"," S SDPOSIT=$$GET1^DIQ(409.3,SDPOSS,6),SDPT=$$GET1^DIQ(409.3,SDPOSS,.01)
.S SDPT=SDPT_" ",SDPT=$E(SDPT,1,31)
.S SDLN=SDLN+1,SDTEXT(SDLN)=SDPT_SDPOSIT
S SDLN=SDLN+1,SDTEXT(SDLN)=""
S SDLN=SDLN+1,SDTEXT(SDLN)="PATIENT SPECIALTY",SDLN=SDLN+1
S SDLN=SDLN+1,SDTEXT(SDLN)="----------------------------------------------------------",SDLN=SDLN+1
S SDSPEC=0 F S SDSPEC=$O(^TMP("SD769P",$J,"SPEC",SDSPEC)) Q:'SDSPEC D
.S SDSPECS=SDSPEC_"," S SDSPECTY=$$GET1^DIQ(409.3,SDSPECS,7),SDPT=$$GET1^DIQ(409.3,SDSPECS,.01)
.S SDPT=SDPT_" ",SDPT=$E(SDPT,1,31)
.S SDLN=SDLN+1,SDTEXT(SDLN)=SDPT_SDPOSIT
D ^XMD
K ^TMP("SD769P",$J)
MENLST ;Protocol Menu list
;;SDAM MENU
;;$$END
;
PROLST ;Protocol to remove
;;SD WAIT LIST DISPOSITION
;;SD WAIT LIST DISPLAY
;;$$END
;
DISLST ;Protocols to Disable
;;SDWL XFER ACC ACCEPT
;;SDWL XFER ACC EWL
;;SDWL XFER ACC MNU MAIN
;;SDWL XFER ACC MNU VIEW
;;SDWL XFER ACC PCMM
;;SDWL XFER ACC PRINT C/S
;;SDWL XFER ACC REJECT
;;SDWL XFER ACC VIEW
;;SDWL XFER REQ INAC
;;SDWL XFER REQ MNU INAC
;;SDWL XFER REQ MNU MAIN
;;SDWL XFER REQ MNU REMV
;;SDWL XFER REQ MNU VIEW
;;SDWL XFER REQ NEW
;;SDWL XFER REQ REMV
;;SDWL XFER REQ REMV CONF
;;SDWL XFER REQ VIEW
;;SD WAIT LIST DISPLAY
;;SD WAIT LIST DISPOSITION
;;$$END
;
OPTLST ;Options to mark OOO
;;SCMC PCMM EWL MENU
;;SD WAIT CLEAN-UP MENU REMOVE
;;SD WAIT ENROLL CLEANUP RPT
;;SD WAIT ENROLLEE APPLY TF
;;SD WAIT ENROLLEE B/R UTILITY
;;SD WAIT ENROLLEE TEMP FILE
;;SD WAIT LIST 30>30>120 REPORT
;;SD WAIT LIST ADHOC REPORT V1
;;SD WAIT LIST ADHOC REPORT V2
;;SD WAIT LIST APPT REPORT
;;SD WAIT LIST CLEANUP
;;SD WAIT LIST ENROLL REPORT
;;SD WAIT LIST GUI
;;SD WAIT LIST INQUIRY
;;SD WAIT LIST MENU
;;SD WAIT LIST OPEN CLOSED ENTRY
;;SD WAIT LIST OVERDUE REPORT
;;SD WAIT LIST PAR ENTER/EDIT
;;SD WAIT LIST PRM CARE/TEAM
;;SD WAIT LIST REOPEN ENTRIES
;;SD WAIT LIST REPORTS MENU
;;SD WAIT LIST SC PRIORITY EDIT
;;SD WAIT LIST STAT REPORT
;;SD WAIT LIST UPLOAD VSSC
;;SD WAIT LIST UTILITIES
;;SDWL 30 DAY REPORT
;;SDWL BATCH CLINIC CHANGE
;;SDWL ENTER/EDIT WITH ACA FLAG
;;SDWL NON-REMOVAL REASON RPT
;;SDWL TRANSFER ACCEPT
;;SDWL TRANSFER PRINT REQUESTS
;;SDWL TRANSFER REQUEST
;;SDWL WAIT TIME STATISTICS
;;SDWL-XFER-SERVER
;;SD WAIT LIST DISPOSITION ENTRY
;;$$END
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSD53769P 9268 printed Nov 22, 2024@17:55:26 Page 2
SD53769P ;MNT/BJR - MARK EWL OPT/PROT OOO ;Oct 05, 2021@08:58
+1 ;;5.3;Scheduling;**769**;Aug 13, 1993;Build 22
+2 ;
+3 QUIT
+4 ;References to DELETE^XPDPROT supported by DBIA #5567
+5 ;References to OUT^XPDPROT supported by DBIA #5567
+6 ;References to OUT^XPDMENU supported by DBIA #1157
+7 ;References to BMES^XPDUTL supported by DBIA #10141
+8 ;References to XREF^XQORM supported by DBIA #10140
+9 ;References to GET1^DIQ supported by DBIA #2056
+10 ;References to GOTLOCAL^XMXAPIG supported by DBIA #3006
+11 ;References to ^XMD supported by DBIA #10070
+12 ;References to ^DIE supported by DBIA #10018
+13 ;
+14 ;Post-init routine for EWL Decommission
+15 ;
+16 ;
EN ;Entry point for SD*5.3*769 Post Install routine
+1 DO DELPROT
+2 DO DISPROT
+3 DO DISOPT
+4 DO CHKCLN
+5 DO DISPAT
+6 DO CHKCLN
+7 DO INACLN
+8 DO DISCLN
+9 QUIT
DELPROT ;Delete Protocol from List Protocol
+1 NEW SDOM,SDMN,SDPROT,SDCHK,SDOP,SDTEXT,XQORM
+2 FOR SDOM=1:1
SET SDMN=$PIECE($TEXT(MENLST+SDOM),";;",2)
if SDMN="$$END"
QUIT
Begin DoDot:1
+3 FOR SDOP=1:1
SET SDPROT=$PIECE($TEXT(PROLST+SDOP),";;",2)
if SDPROT="$$END"
QUIT
Begin DoDot:2
+4 SET SDCHK=$$DELETE^XPDPROT(SDMN,SDPROT)
+5 IF SDCHK
SET SDTEXT="The "_SDPROT_" protocol has been deleted from the "_SDMN_" protocol menu."
DO BMES^XPDUTL(SDTEXT)
+6 IF 'SDCHK
SET SDTEXT="The "_SDPROT_" protocol could not be deleted from the "_SDMN_" protocol menu. It may have already been removed."
DO BMES^XPDUTL(SDTEXT)
End DoDot:2
End DoDot:1
+7 SET XQORM=$ORDER(^ORD(101,"B","SDAM MENU",0))_";ORD(101,"
+8 ;Force protocol recompile.
DO XREF^XQORM
+9 QUIT
+10 ;
DISPROT ;Disable Protocols
+1 NEW SDPRTL,SDPR,SDTEXT
+2 FOR SDPR=1:1
SET SDPRTL=$PIECE($TEXT(DISLST+SDPR),";;",2)
if SDPRTL="$$END"
QUIT
Begin DoDot:1
+3 DO OUT^XPDPROT(SDPRTL,"DO NOT USE!! - EWL DECOM - SD*5.3*769")
+4 SET SDTEXT="The "_SDPRTL_" protocol has been disabled."
DO BMES^XPDUTL(SDTEXT)
End DoDot:1
+5 QUIT
DISOPT ;Mark Options OOO
+1 NEW SDOPT,SDCNT,SDTEXT
+2 FOR SDCNT=1:1
SET SDOPT=$PIECE($TEXT(OPTLST+SDCNT),";;",2)
if SDOPT="$$END"
QUIT
Begin DoDot:1
+3 DO OUT^XPDMENU(SDOPT,"DO NOT USE!! - EWL DECOM - SD*5.3*769")
+4 SET SDTEXT="The "_SDOPT_" option has been marked out of order."
DO BMES^XPDUTL(SDTEXT)
End DoDot:1
+5 QUIT
CHKCLN ;Check wait list clinics for active appointments
+1 NEW SDCLN,SDCLNS,SDWLSCN,SDWLCNT,SDWLN
+2 KILL ^TMP("SD769P",$JOB)
+3 SET SDCLN=0
FOR
SET SDCLN=$ORDER(^SDWL(409.32,SDCLN))
if 'SDCLN
QUIT
Begin DoDot:1
+4 SET SDCLNS=SDCLN_","
+5 if ($PIECE(^SDWL(409.32,SDCLN,0),U,4))
QUIT
+6 if ($$GET1^DIQ(409.32,SDCLNS,.01)["VCL")
QUIT
+7 SET SDCLNS=SDCLN_","
SET SDWLSCN=$PIECE($GET(^SDWL(409.32,SDCLN,0)),U,1)
+8 IF $DATA(^SDWL(409.3,"SC",SDWLSCN))&'$PIECE($GET(^SDWL(409.32,SDCLN,0)),U,4)
Begin DoDot:2
+9 SET SDWLN=""
SET SDWLCNT=0
FOR
SET SDWLN=$ORDER(^SDWL(409.3,"SC",SDWLSCN,SDWLN))
if SDWLN=""
QUIT
Begin DoDot:3
+10 IF '$DATA(^SDWL(409.3,SDWLN,"DIS"))
SET ^TMP("SD769P",$JOB,"DIS",SDWLSCN,SDWLN)=""
End DoDot:3
End DoDot:2
End DoDot:1
+11 QUIT
DISPAT ;Remove entries without patient info
+1 NEW SDWLN,SDCNT,SDPAT,SDCLN,SDIEN,SDTM,SDPOS,SDSPL,DA,DIE,DR,SDWLCL
+2 SET SDWLCL=0
FOR
SET SDWLCL=$ORDER(^TMP("SD769P",$JOB,"DIS",SDWLCL))
if 'SDWLCL
QUIT
Begin DoDot:1
+3 SET SDWLN=0
FOR
SET SDWLN=$ORDER(^TMP("SD769P",$JOB,"DIS",SDWLCL,SDWLN))
if 'SDWLN
QUIT
Begin DoDot:2
+4 SET SDPAT=$$GET1^DIQ(409.3,SDWLN,.01)
SET SDCLN=$$GET1^DIQ(409.3,SDWLN,8)
SET SDIEN=SDWLN
+5 SET SDTM=$$GET1^DIQ(409.3,SDWLN,5)
SET SDPOS=$$GET1^DIQ(409.3,SDWLN,6)
SET SDSPL=$$GET1^DIQ(409.3,SDWLN,7)
+6 IF SDPAT=""
IF SDTM=""
IF SDPOS=""
IF SDSPL=""
Begin DoDot:3
+7 SET $PIECE(^SDWL(409.3,SDWLN,0),U)=0
SET DA=SDIEN
SET DIK="^SDWL(409.3,"
DO ^DIK
+8 SET SDTXT="Wait List Entry number "_SDIEN_" with no patient info has been deleted."
DO BMES^XPDUTL(SDTXT)
End DoDot:3
End DoDot:2
End DoDot:1
+9 QUIT
INACLN ;Inactivate wait list clinics without active appointments
+1 NEW SDCLN,SDCLNS,SDWLSCN,SDWLCNT,SDWLN,SDWLSTOP,SDX,DR,DA,DIE,SDTXT
+2 KILL ^TMP("SD769P",$JOB)
+3 SET SDCLN=0
FOR
SET SDCLN=$ORDER(^SDWL(409.32,SDCLN))
if 'SDCLN
QUIT
Begin DoDot:1
+4 SET SDCLNS=SDCLN_","
+5 if ($PIECE(^SDWL(409.32,SDCLN,0),U,4))'=""
QUIT
+6 if ($$GET1^DIQ(409.32,SDCLNS,.01)["VCL")
QUIT
+7 SET SDCLNS=SDCLN_","
SET SDWLSCN=$PIECE($GET(^SDWL(409.32,SDCLN,0)),U,1)
SET SDWLSTOP=0
+8 IF $DATA(^SDWL(409.3,"SC",SDWLSCN))&'$PIECE($GET(^SDWL(409.32,SDCLN,0)),U,4)
Begin DoDot:2
+9 SET SDWLN=""
SET SDWLCNT=0
FOR
SET SDWLN=$ORDER(^SDWL(409.3,"SC",SDWLSCN,SDWLN))
if SDWLN=""
QUIT
Begin DoDot:3
+10 SET SDX=$GET(^SDWL(409.3,SDWLN,0))
IF '$DATA(^SDWL(409.3,SDWLN,"DIS"))
SET ^TMP("SD769P",$JOB,"DIS",SDWLN)=""
SET SDWLSTOP=1
End DoDot:3
End DoDot:2
+11 IF SDWLSTOP
SET SDTEXT="Clinic "_$$GET1^DIQ(409.32,SDCLNS,.01)_" has Patients on the Wait List and cannot be inactivated."
DO BMES^XPDUTL(SDTEXT)
QUIT
+12 SET DR="3///^S X=DT;4///^S X=.5"
SET DIE="^SDWL(409.32,"
SET DA=SDCLN
DO ^DIE
+13 SET SDTXT="Wait List Clinic "_$$GET1^DIQ(409.32,SDCLNS,.01)_" has been inactivated."
DO BMES^XPDUTL(SDTXT)
End DoDot:1
+14 QUIT
LSTOTH ;List active Wait List entries not clinic specific
+1 NEW SDPAT,SDCLN,SDIEN,SDTM,SDPOS,SDSPL
+2 SET SDIEN=0
FOR
SET SDIEN=$ORDER(^SDWL(409.3,SDIEN))
if 'SDIEN
QUIT
Begin DoDot:1
+3 ;Quit if Clinic exists
if $PIECE(^SDWL(409.3,SDIEN,0),U,8)'=""
QUIT
+4 ;Quit if Dispositioned
if $DATA(^SDWL(409.3,SDIEN,"DIS"))
QUIT
+5 IF $PIECE(^SDWL(409.3,SDIEN,0),U,5)'=""
SET ^TMP("SD769P",$JOB,"TEAM",SDIEN)=""
QUIT
+6 IF $PIECE(^SDWL(409.3,SDIEN,0),U,6)'=""
SET ^TMP("SD769P",$JOB,"POS",SDIEN)=""
QUIT
+7 IF $PIECE(^SDWL(409.3,SDIEN,0),U,7)'=""
SET ^TMP("SD769P",$JOB,"SPEC",SDIEN)=""
QUIT
End DoDot:1
+8 QUIT
DISCLN ;
+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*769 Post-Install Job Results"
+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*769 post-install job results."
+11 SET SDLN=2
+12 SET SDTEXT(SDLN)="The Following Wait List Entries need to be scheduled for the following patients."
SET SDLN=SDLN+1
+13 SET SDTEXT(SDLN)="PATIENT CLINIC"
SET SDLN=SDLN+1
+14 SET SDTEXT(SDLN)="----------------------------------------------------------"
SET SDLN=SDLN+1
+15 SET SDWLN=0
FOR
SET SDWLN=$ORDER(^TMP("SD769P",$JOB,"DIS",SDWLN))
if 'SDWLN
QUIT
Begin DoDot:1
+16 SET SDCLNS=SDWLN_","
SET SDWLSCN=$$GET1^DIQ(409.3,SDCLNS,8)
SET SDPT=$$GET1^DIQ(409.3,SDCLNS,.01)
+17 SET SDPT=SDPT_" "
SET SDPT=$EXTRACT(SDPT,1,31)
+18 SET SDLN=SDLN+1
SET SDTEXT(SDLN)=SDPT_SDWLSCN
End DoDot:1
+19 SET SDLN=SDLN+1
SET SDTEXT(SDLN)=""
+20 SET SDLN=SDLN+1
SET SDTEXT(SDLN)="PATIENT TEAM"
SET SDLN=SDLN+1
+21 SET SDLN=SDLN+1
SET SDTEXT(SDLN)="----------------------------------------------------------"
SET SDLN=SDLN+1
+22 SET SDTM=0
FOR
SET SDTM=$ORDER(^TMP("SD769P",$JOB,"TEAM",SDTM))
if 'SDTM
QUIT
Begin DoDot:1
+23 SET SDTMS=SDTM_","
SET SDTEAM=$$GET1^DIQ(409.3,SDTMS,5)
SET SDPT=$$GET1^DIQ(409.3,SDTMS,.01)
+24 SET SDPT=SDPT_" "
SET SDPT=$EXTRACT(SDPT,1,31)
+25 SET SDLN=SDLN+1
SET SDTEXT(SDLN)=SDPT_SDTEAM
End DoDot:1
+26 SET SDLN=SDLN+1
SET SDTEXT(SDLN)=""
+27 SET SDLN=SDLN+1
SET SDTEXT(SDLN)="PATIENT POSITION"
SET SDLN=SDLN+1
+28 SET SDLN=SDLN+1
SET SDTEXT(SDLN)="----------------------------------------------------------"
SET SDLN=SDLN+1
+29 SET SDPOS=0
FOR
SET SDPOS=$ORDER(^TMP("SD769P",$JOB,"POS",SDPOS))
if 'SDPOS
QUIT
Begin DoDot:1
+30 SET SDPOSS=SDPOS_","
SET SDPOSIT=$$GET1^DIQ(409.3,SDPOSS,6)
SET SDPT=$$GET1^DIQ(409.3,SDPOSS,.01)
+31 SET SDPT=SDPT_" "
SET SDPT=$EXTRACT(SDPT,1,31)
+32 SET SDLN=SDLN+1
SET SDTEXT(SDLN)=SDPT_SDPOSIT
End DoDot:1
+33 SET SDLN=SDLN+1
SET SDTEXT(SDLN)=""
+34 SET SDLN=SDLN+1
SET SDTEXT(SDLN)="PATIENT SPECIALTY"
SET SDLN=SDLN+1
+35 SET SDLN=SDLN+1
SET SDTEXT(SDLN)="----------------------------------------------------------"
SET SDLN=SDLN+1
+36 SET SDSPEC=0
FOR
SET SDSPEC=$ORDER(^TMP("SD769P",$JOB,"SPEC",SDSPEC))
if 'SDSPEC
QUIT
Begin DoDot:1
+37 SET SDSPECS=SDSPEC_","
SET SDSPECTY=$$GET1^DIQ(409.3,SDSPECS,7)
SET SDPT=$$GET1^DIQ(409.3,SDSPECS,.01)
+38 SET SDPT=SDPT_" "
SET SDPT=$EXTRACT(SDPT,1,31)
+39 SET SDLN=SDLN+1
SET SDTEXT(SDLN)=SDPT_SDPOSIT
End DoDot:1
+40 DO ^XMD
+41 KILL ^TMP("SD769P",$JOB)
MENLST ;Protocol Menu list
+1 ;;SDAM MENU
+2 ;;$$END
+3 ;
PROLST ;Protocol to remove
+1 ;;SD WAIT LIST DISPOSITION
+2 ;;SD WAIT LIST DISPLAY
+3 ;;$$END
+4 ;
DISLST ;Protocols to Disable
+1 ;;SDWL XFER ACC ACCEPT
+2 ;;SDWL XFER ACC EWL
+3 ;;SDWL XFER ACC MNU MAIN
+4 ;;SDWL XFER ACC MNU VIEW
+5 ;;SDWL XFER ACC PCMM
+6 ;;SDWL XFER ACC PRINT C/S
+7 ;;SDWL XFER ACC REJECT
+8 ;;SDWL XFER ACC VIEW
+9 ;;SDWL XFER REQ INAC
+10 ;;SDWL XFER REQ MNU INAC
+11 ;;SDWL XFER REQ MNU MAIN
+12 ;;SDWL XFER REQ MNU REMV
+13 ;;SDWL XFER REQ MNU VIEW
+14 ;;SDWL XFER REQ NEW
+15 ;;SDWL XFER REQ REMV
+16 ;;SDWL XFER REQ REMV CONF
+17 ;;SDWL XFER REQ VIEW
+18 ;;SD WAIT LIST DISPLAY
+19 ;;SD WAIT LIST DISPOSITION
+20 ;;$$END
+21 ;
OPTLST ;Options to mark OOO
+1 ;;SCMC PCMM EWL MENU
+2 ;;SD WAIT CLEAN-UP MENU REMOVE
+3 ;;SD WAIT ENROLL CLEANUP RPT
+4 ;;SD WAIT ENROLLEE APPLY TF
+5 ;;SD WAIT ENROLLEE B/R UTILITY
+6 ;;SD WAIT ENROLLEE TEMP FILE
+7 ;;SD WAIT LIST 30>30>120 REPORT
+8 ;;SD WAIT LIST ADHOC REPORT V1
+9 ;;SD WAIT LIST ADHOC REPORT V2
+10 ;;SD WAIT LIST APPT REPORT
+11 ;;SD WAIT LIST CLEANUP
+12 ;;SD WAIT LIST ENROLL REPORT
+13 ;;SD WAIT LIST GUI
+14 ;;SD WAIT LIST INQUIRY
+15 ;;SD WAIT LIST MENU
+16 ;;SD WAIT LIST OPEN CLOSED ENTRY
+17 ;;SD WAIT LIST OVERDUE REPORT
+18 ;;SD WAIT LIST PAR ENTER/EDIT
+19 ;;SD WAIT LIST PRM CARE/TEAM
+20 ;;SD WAIT LIST REOPEN ENTRIES
+21 ;;SD WAIT LIST REPORTS MENU
+22 ;;SD WAIT LIST SC PRIORITY EDIT
+23 ;;SD WAIT LIST STAT REPORT
+24 ;;SD WAIT LIST UPLOAD VSSC
+25 ;;SD WAIT LIST UTILITIES
+26 ;;SDWL 30 DAY REPORT
+27 ;;SDWL BATCH CLINIC CHANGE
+28 ;;SDWL ENTER/EDIT WITH ACA FLAG
+29 ;;SDWL NON-REMOVAL REASON RPT
+30 ;;SDWL TRANSFER ACCEPT
+31 ;;SDWL TRANSFER PRINT REQUESTS
+32 ;;SDWL TRANSFER REQUEST
+33 ;;SDWL WAIT TIME STATISTICS
+34 ;;SDWL-XFER-SERVER
+35 ;;SD WAIT LIST DISPOSITION ENTRY
+36 ;;$$END
