Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SD53769P

SD53769P.m

Go to the documentation of this file. 
  1. SD53769P ;MNT/BJR - MARK EWL OPT/PROT OOO ;Oct 05, 2021@08:58
  1.  ;;5.3;Scheduling;**769**;Aug 13, 1993;Build 22
  1.  ;
  1.  Q
  1.  ;References to DELETE^XPDPROT supported by DBIA #5567
  1.  ;References to OUT^XPDPROT supported by DBIA #5567
  1.  ;References to OUT^XPDMENU supported by DBIA #1157
  1.  ;References to BMES^XPDUTL supported by DBIA #10141
  1.  ;References to XREF^XQORM supported by DBIA #10140
  1.  ;References to GET1^DIQ supported by DBIA #2056
  1.  ;References to GOTLOCAL^XMXAPIG supported by DBIA #3006
  1.  ;References to ^XMD supported by DBIA #10070
  1.  ;References to ^DIE supported by DBIA #10018
  1.  ;
  1.  ;Post-init routine for EWL Decommission
  1.  ;
  1.  ;
  1. EN ;Entry point for SD*5.3*769 Post Install routine
  1.  D DELPROT
  1.  D DISPROT
  1.  D DISOPT
  1.  D CHKCLN
  1.  D DISPAT
  1.  D CHKCLN
  1.  D INACLN
  1.  D DISCLN
  1.  Q
  1. DELPROT ;Delete Protocol from List Protocol
  1.  N SDOM,SDMN,SDPROT,SDCHK,SDOP,SDTEXT,XQORM
  1.  F SDOM=1:1 S SDMN=$P($TEXT(MENLST+SDOM),";;",2) Q:SDMN="$$END"  D
  1.  .F SDOP=1:1 S SDPROT=$P($TEXT(PROLST+SDOP),";;",2) Q:SDPROT="$$END"  D
  1.  ..S SDCHK=$$DELETE^XPDPROT(SDMN,SDPROT)
  1.  ..I SDCHK S SDTEXT="The "_SDPROT_" protocol has been deleted from the "_SDMN_" protocol menu." D BMES^XPDUTL(SDTEXT)
  1.  ..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)
  1.  S XQORM=$O(^ORD(101,"B","SDAM MENU",0))_";ORD(101,"
  1.  D XREF^XQORM ;Force protocol recompile.
  1.  Q
  1.  ;
  1. DISPROT ;Disable Protocols
  1.  N SDPRTL,SDPR,SDTEXT
  1.  F SDPR=1:1 S SDPRTL=$P($TEXT(DISLST+SDPR),";;",2) Q:SDPRTL="$$END"  D
  1.  .D OUT^XPDPROT(SDPRTL,"DO NOT USE!! - EWL DECOM - SD*5.3*769")
  1.  .S SDTEXT="The "_SDPRTL_" protocol has been disabled." D BMES^XPDUTL(SDTEXT)
  1.  Q
  1. DISOPT ;Mark Options OOO
  1.  N SDOPT,SDCNT,SDTEXT
  1.  F SDCNT=1:1 S SDOPT=$P($TEXT(OPTLST+SDCNT),";;",2) Q:SDOPT="$$END"  D
  1.  .D OUT^XPDMENU(SDOPT,"DO NOT USE!! - EWL DECOM - SD*5.3*769")
  1.  .S SDTEXT="The "_SDOPT_" option has been marked out of order." D BMES^XPDUTL(SDTEXT)
  1.  Q
  1. CHKCLN ;Check wait list clinics for active appointments
  1.  N SDCLN,SDCLNS,SDWLSCN,SDWLCNT,SDWLN
  1.  K ^TMP("SD769P",$J)
  1.  S SDCLN=0 F  S SDCLN=$O(^SDWL(409.32,SDCLN)) Q:'SDCLN  D
  1.  .S SDCLNS=SDCLN_","
  1.  .Q:($P(^SDWL(409.32,SDCLN,0),U,4))
  1.  .Q:($$GET1^DIQ(409.32,SDCLNS,.01)["VCL")
  1.  .S SDCLNS=SDCLN_"," S SDWLSCN=$P($G(^SDWL(409.32,SDCLN,0)),U,1)
  1.  .I $D(^SDWL(409.3,"SC",SDWLSCN))&'$P($G(^SDWL(409.32,SDCLN,0)),U,4) D
  1.  ..S SDWLN="",SDWLCNT=0 F  S SDWLN=$O(^SDWL(409.3,"SC",SDWLSCN,SDWLN)) Q:SDWLN=""  D
  1.  ...I '$D(^SDWL(409.3,SDWLN,"DIS")) S ^TMP("SD769P",$J,"DIS",SDWLSCN,SDWLN)=""
  1.  Q
  1. DISPAT ;Remove entries without patient info
  1.  N SDWLN,SDCNT,SDPAT,SDCLN,SDIEN,SDTM,SDPOS,SDSPL,DA,DIE,DR,SDWLCL
  1.  S SDWLCL=0 F  S SDWLCL=$O(^TMP("SD769P",$J,"DIS",SDWLCL)) Q:'SDWLCL  D
  1.  .S SDWLN=0 F  S SDWLN=$O(^TMP("SD769P",$J,"DIS",SDWLCL,SDWLN)) Q:'SDWLN  D
  1.  ..S SDPAT=$$GET1^DIQ(409.3,SDWLN,.01),SDCLN=$$GET1^DIQ(409.3,SDWLN,8),SDIEN=SDWLN
  1.  ..S SDTM=$$GET1^DIQ(409.3,SDWLN,5),SDPOS=$$GET1^DIQ(409.3,SDWLN,6),SDSPL=$$GET1^DIQ(409.3,SDWLN,7)
  1.  ..I SDPAT="",SDTM="",SDPOS="",SDSPL="" D
  1.  ...S $P(^SDWL(409.3,SDWLN,0),U)=0,DA=SDIEN,DIK="^SDWL(409.3," D ^DIK
  1.  ...S SDTXT="Wait List Entry number "_SDIEN_" with no patient info has been deleted." D BMES^XPDUTL(SDTXT)
  1.  Q
  1. INACLN ;Inactivate wait list clinics without active appointments
  1.  N SDCLN,SDCLNS,SDWLSCN,SDWLCNT,SDWLN,SDWLSTOP,SDX,DR,DA,DIE,SDTXT
  1.  K ^TMP("SD769P",$J)
  1.  S SDCLN=0 F  S SDCLN=$O(^SDWL(409.32,SDCLN)) Q:'SDCLN  D
  1.  .S SDCLNS=SDCLN_","
  1.  .Q:($P(^SDWL(409.32,SDCLN,0),U,4))'=""
  1.  .Q:($$GET1^DIQ(409.32,SDCLNS,.01)["VCL")
  1.  .S SDCLNS=SDCLN_",",SDWLSCN=$P($G(^SDWL(409.32,SDCLN,0)),U,1),SDWLSTOP=0
  1.  .I $D(^SDWL(409.3,"SC",SDWLSCN))&'$P($G(^SDWL(409.32,SDCLN,0)),U,4) D
  1.  ..S SDWLN="",SDWLCNT=0 F  S SDWLN=$O(^SDWL(409.3,"SC",SDWLSCN,SDWLN)) Q:SDWLN=""  D
  1.  ...S SDX=$G(^SDWL(409.3,SDWLN,0)) I '$D(^SDWL(409.3,SDWLN,"DIS")) S ^TMP("SD769P",$J,"DIS",SDWLN)="",SDWLSTOP=1
  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
  1.  .S DR="3///^S X=DT;4///^S X=.5",DIE="^SDWL(409.32,",DA=SDCLN D ^DIE
  1.  .S SDTXT="Wait List Clinic "_$$GET1^DIQ(409.32,SDCLNS,.01)_" has been inactivated." D BMES^XPDUTL(SDTXT)
  1.  Q
  1. LSTOTH ;List active Wait List entries not clinic specific
  1.  N SDPAT,SDCLN,SDIEN,SDTM,SDPOS,SDSPL
  1.  S SDIEN=0 F  S SDIEN=$O(^SDWL(409.3,SDIEN)) Q:'SDIEN  D
  1.  .Q:$P(^SDWL(409.3,SDIEN,0),U,8)'=""  ;Quit if Clinic exists
  1.  .Q:$D(^SDWL(409.3,SDIEN,"DIS"))  ;Quit if Dispositioned
  1.  .I $P(^SDWL(409.3,SDIEN,0),U,5)'="" S ^TMP("SD769P",$J,"TEAM",SDIEN)="" Q
  1.  .I $P(^SDWL(409.3,SDIEN,0),U,6)'="" S ^TMP("SD769P",$J,"POS",SDIEN)="" Q
  1.  .I $P(^SDWL(409.3,SDIEN,0),U,7)'="" S ^TMP("SD769P",$J,"SPEC",SDIEN)="" Q
  1.  Q
  1. DISCLN ;
  1.  N DIFROM ;when invoking ^XMD in post-init routine of the KIDS build, the calling routine must NEW the DIFROM variable
  1.  N XMSUB,XMTEXT,XMY ;input vars for ^XMD call
  1.  N SDWLN,SDTEXT,SDLN,SDPT,SDTM,SDPOS,SDPOSS,SDTMS,SDTEAM,SDSPEC,SDSPECS,SDSPECTY,SDPOSIT ;local vars
  1.  ;construct mailman msg
  1.  S XMSUB="SD*5.3*769 Post-Install Job Results" ;msg subject
  1.  I $$GOTLOCAL^XMXAPIG("SD EWL BACKGROUND UPDATE") S XMY("G.SD EWL BACKGROUND UPDATE")="" ;send message to mail group
  1.  I '$$GOTLOCAL^XMXAPIG("SD EWL BACKGROUND UPDATE") S XMY($G(DUZ))="" ;msg addressee array
  1.  S XMTEXT="SDTEXT(" ;array containing the text of msg
  1.  S SDLN=1 ;msg line #
  1.  S SDTEXT(SDLN)="SD*5.3*769 post-install job results."
  1.  S SDLN=2
  1.  S SDTEXT(SDLN)="The Following Wait List Entries need to be scheduled for the following patients.",SDLN=SDLN+1
  1.  S SDTEXT(SDLN)="PATIENT                        CLINIC",SDLN=SDLN+1
  1.  S SDTEXT(SDLN)="----------------------------------------------------------",SDLN=SDLN+1
  1.  S SDWLN=0 F  S SDWLN=$O(^TMP("SD769P",$J,"DIS",SDWLN)) Q:'SDWLN  D
  1.  .S SDCLNS=SDWLN_"," S SDWLSCN=$$GET1^DIQ(409.3,SDCLNS,8),SDPT=$$GET1^DIQ(409.3,SDCLNS,.01)
  1.  .S SDPT=SDPT_"                               ",SDPT=$E(SDPT,1,31)
  1.  .S SDLN=SDLN+1,SDTEXT(SDLN)=SDPT_SDWLSCN
  1.  S SDLN=SDLN+1,SDTEXT(SDLN)=""
  1.  S SDLN=SDLN+1,SDTEXT(SDLN)="PATIENT                        TEAM",SDLN=SDLN+1
  1.  S SDLN=SDLN+1,SDTEXT(SDLN)="----------------------------------------------------------",SDLN=SDLN+1
  1.  S SDTM=0 F  S SDTM=$O(^TMP("SD769P",$J,"TEAM",SDTM)) Q:'SDTM  D
  1.  .S SDTMS=SDTM_"," S SDTEAM=$$GET1^DIQ(409.3,SDTMS,5),SDPT=$$GET1^DIQ(409.3,SDTMS,.01)
  1.  .S SDPT=SDPT_"                               ",SDPT=$E(SDPT,1,31)
  1.  .S SDLN=SDLN+1,SDTEXT(SDLN)=SDPT_SDTEAM
  1.  S SDLN=SDLN+1,SDTEXT(SDLN)=""
  1.  S SDLN=SDLN+1,SDTEXT(SDLN)="PATIENT                        POSITION",SDLN=SDLN+1
  1.  S SDLN=SDLN+1,SDTEXT(SDLN)="----------------------------------------------------------",SDLN=SDLN+1
  1.  S SDPOS=0 F  S SDPOS=$O(^TMP("SD769P",$J,"POS",SDPOS)) Q:'SDPOS  D
  1.  .S SDPOSS=SDPOS_"," S SDPOSIT=$$GET1^DIQ(409.3,SDPOSS,6),SDPT=$$GET1^DIQ(409.3,SDPOSS,.01)
  1.  .S SDPT=SDPT_"                               ",SDPT=$E(SDPT,1,31)
  1.  .S SDLN=SDLN+1,SDTEXT(SDLN)=SDPT_SDPOSIT
  1.  S SDLN=SDLN+1,SDTEXT(SDLN)=""
  1.  S SDLN=SDLN+1,SDTEXT(SDLN)="PATIENT                        SPECIALTY",SDLN=SDLN+1
  1.  S SDLN=SDLN+1,SDTEXT(SDLN)="----------------------------------------------------------",SDLN=SDLN+1
  1.  S SDSPEC=0 F  S SDSPEC=$O(^TMP("SD769P",$J,"SPEC",SDSPEC)) Q:'SDSPEC  D
  1.  .S SDSPECS=SDSPEC_"," S SDSPECTY=$$GET1^DIQ(409.3,SDSPECS,7),SDPT=$$GET1^DIQ(409.3,SDSPECS,.01)
  1.  .S SDPT=SDPT_"                               ",SDPT=$E(SDPT,1,31)
  1.  .S SDLN=SDLN+1,SDTEXT(SDLN)=SDPT_SDPOSIT
  1.  D ^XMD
  1.  K ^TMP("SD769P",$J)
  1. MENLST ;Protocol Menu list
  1.  ;;SDAM MENU
  1.  ;;$$END
  1.  ;
  1. PROLST ;Protocol to remove
  1.  ;;SD WAIT LIST DISPOSITION
  1.  ;;SD WAIT LIST DISPLAY
  1.  ;;$$END
  1.  ;
  1. DISLST ;Protocols to Disable
  1.  ;;SDWL XFER ACC ACCEPT
  1.  ;;SDWL XFER ACC EWL
  1.  ;;SDWL XFER ACC MNU MAIN
  1.  ;;SDWL XFER ACC MNU VIEW
  1.  ;;SDWL XFER ACC PCMM
  1.  ;;SDWL XFER ACC PRINT C/S
  1.  ;;SDWL XFER ACC REJECT
  1.  ;;SDWL XFER ACC VIEW
  1.  ;;SDWL XFER REQ INAC
  1.  ;;SDWL XFER REQ MNU INAC
  1.  ;;SDWL XFER REQ MNU MAIN
  1.  ;;SDWL XFER REQ MNU REMV
  1.  ;;SDWL XFER REQ MNU VIEW
  1.  ;;SDWL XFER REQ NEW
  1.  ;;SDWL XFER REQ REMV
  1.  ;;SDWL XFER REQ REMV CONF
  1.  ;;SDWL XFER REQ VIEW
  1.  ;;SD WAIT LIST DISPLAY
  1.  ;;SD WAIT LIST DISPOSITION
  1.  ;;$$END
  1.  ;
  1. OPTLST ;Options to mark OOO
  1.  ;;SCMC PCMM EWL MENU
  1.  ;;SD WAIT CLEAN-UP MENU REMOVE
  1.  ;;SD WAIT ENROLL CLEANUP RPT
  1.  ;;SD WAIT ENROLLEE APPLY TF
  1.  ;;SD WAIT ENROLLEE B/R UTILITY
  1.  ;;SD WAIT ENROLLEE TEMP FILE
  1.  ;;SD WAIT LIST 30>30>120 REPORT
  1.  ;;SD WAIT LIST ADHOC REPORT V1
  1.  ;;SD WAIT LIST ADHOC REPORT V2
  1.  ;;SD WAIT LIST APPT REPORT
  1.  ;;SD WAIT LIST CLEANUP
  1.  ;;SD WAIT LIST ENROLL REPORT
  1.  ;;SD WAIT LIST GUI
  1.  ;;SD WAIT LIST INQUIRY
  1.  ;;SD WAIT LIST MENU
  1.  ;;SD WAIT LIST OPEN CLOSED ENTRY
  1.  ;;SD WAIT LIST OVERDUE REPORT
  1.  ;;SD WAIT LIST PAR ENTER/EDIT
  1.  ;;SD WAIT LIST PRM CARE/TEAM
  1.  ;;SD WAIT LIST REOPEN ENTRIES
  1.  ;;SD WAIT LIST REPORTS MENU
  1.  ;;SD WAIT LIST SC PRIORITY EDIT
  1.  ;;SD WAIT LIST STAT REPORT
  1.  ;;SD WAIT LIST UPLOAD VSSC
  1.  ;;SD WAIT LIST UTILITIES
  1.  ;;SDWL 30 DAY REPORT
  1.  ;;SDWL BATCH CLINIC CHANGE
  1.  ;;SDWL ENTER/EDIT WITH ACA FLAG
  1.  ;;SDWL NON-REMOVAL REASON RPT
  1.  ;;SDWL TRANSFER ACCEPT
  1.  ;;SDWL TRANSFER PRINT REQUESTS
  1.  ;;SDWL TRANSFER REQUEST
  1.  ;;SDWL WAIT TIME STATISTICS
  1.  ;;SDWL-XFER-SERVER
  1.  ;;SD WAIT LIST DISPOSITION ENTRY
  1.  ;;$$END