Released SD*5.3*786 SEQ #638 Extracted from mail message **KIDS**:SD*5.3*786^ **INSTALL NAME** SD*5.3*786 "BLD",12198,0) SD*5.3*786^SCHEDULING^0^3210427^y "BLD",12198,1,0) ^^2^2^3210427^ "BLD",12198,1,1,0) Patch SD*5.3*786 will unschedule and mark out of order the "BLD",12198,1,2,0) SD EWL Background Job [SD EWL BACKGROUND JOB]. "BLD",12198,4,0) ^9.64PA^^ "BLD",12198,6) 1 "BLD",12198,6.3) 3 "BLD",12198,"INID") ^n "BLD",12198,"INIT") EN^SD53786P "BLD",12198,"KRN",0) ^9.67PA^1.5^25 "BLD",12198,"KRN",.4,0) .4 "BLD",12198,"KRN",.401,0) .401 "BLD",12198,"KRN",.402,0) .402 "BLD",12198,"KRN",.403,0) .403 "BLD",12198,"KRN",.5,0) .5 "BLD",12198,"KRN",.84,0) .84 "BLD",12198,"KRN",1.5,0) 1.5 "BLD",12198,"KRN",1.6,0) 1.6 "BLD",12198,"KRN",1.61,0) 1.61 "BLD",12198,"KRN",1.62,0) 1.62 "BLD",12198,"KRN",3.6,0) 3.6 "BLD",12198,"KRN",3.8,0) 3.8 "BLD",12198,"KRN",9.2,0) 9.2 "BLD",12198,"KRN",9.8,0) 9.8 "BLD",12198,"KRN",9.8,"NM",0) ^9.68A^2^2 "BLD",12198,"KRN",9.8,"NM",1,0) SD53786P^^0^B1725151 "BLD",12198,"KRN",9.8,"NM",2,0) SDWLQSC^^0^B65491758 "BLD",12198,"KRN",9.8,"NM","B","SD53786P",1) "BLD",12198,"KRN",9.8,"NM","B","SDWLQSC",2) "BLD",12198,"KRN",19,0) 19 "BLD",12198,"KRN",19,"NM",0) ^9.68A^1^1 "BLD",12198,"KRN",19,"NM",1,0) SD EWL BACKGROUND JOB^^0 "BLD",12198,"KRN",19,"NM","B","SD EWL BACKGROUND JOB",1) "BLD",12198,"KRN",19.1,0) 19.1 "BLD",12198,"KRN",101,0) 101 "BLD",12198,"KRN",409.61,0) 409.61 "BLD",12198,"KRN",771,0) 771 "BLD",12198,"KRN",779.2,0) 779.2 "BLD",12198,"KRN",870,0) 870 "BLD",12198,"KRN",8989.51,0) 8989.51 "BLD",12198,"KRN",8989.52,0) 8989.52 "BLD",12198,"KRN",8993,0) 8993 "BLD",12198,"KRN",8994,0) 8994 "BLD",12198,"KRN","B",.4,.4) "BLD",12198,"KRN","B",.401,.401) "BLD",12198,"KRN","B",.402,.402) "BLD",12198,"KRN","B",.403,.403) "BLD",12198,"KRN","B",.5,.5) "BLD",12198,"KRN","B",.84,.84) "BLD",12198,"KRN","B",1.5,1.5) "BLD",12198,"KRN","B",1.6,1.6) "BLD",12198,"KRN","B",1.61,1.61) "BLD",12198,"KRN","B",1.62,1.62) "BLD",12198,"KRN","B",3.6,3.6) "BLD",12198,"KRN","B",3.8,3.8) "BLD",12198,"KRN","B",9.2,9.2) "BLD",12198,"KRN","B",9.8,9.8) "BLD",12198,"KRN","B",19,19) "BLD",12198,"KRN","B",19.1,19.1) "BLD",12198,"KRN","B",101,101) "BLD",12198,"KRN","B",409.61,409.61) "BLD",12198,"KRN","B",771,771) "BLD",12198,"KRN","B",779.2,779.2) "BLD",12198,"KRN","B",870,870) "BLD",12198,"KRN","B",8989.51,8989.51) "BLD",12198,"KRN","B",8989.52,8989.52) "BLD",12198,"KRN","B",8993,8993) "BLD",12198,"KRN","B",8994,8994) "BLD",12198,"QDEF") ^^^^^^^^^^YES "BLD",12198,"QUES",0) ^9.62^^ "BLD",12198,"REQB",0) ^9.611^1^1 "BLD",12198,"REQB",1,0) SD*5.3*446^2 "BLD",12198,"REQB","B","SD*5.3*446",1) "INIT") EN^SD53786P "KRN",19,12744,-1) 0^1 "KRN",19,12744,0) SD EWL BACKGROUND JOB^SD EWL BACKGROUND JOB^^R^^^^^^^^ "KRN",19,12744,1,0) ^19.06^2^2^3120327^^^^ "KRN",19,12744,1,1,0) Displays changes in SD WAIT LIST types using mail group SD EWL BACKGROUND "KRN",19,12744,1,2,0) UPDATE. "KRN",19,12744,25) EN^SDWLQSC "KRN",19,12744,200.9) y "KRN",19,12744,"U") SD EWL BACKGROUND JOB "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,22,0) ^9.49I^1^1 "PKG",16,22,1,0) 5.3^2930813 "PKG",16,22,1,"PAH",1,0) 786^3210427 "PKG",16,22,1,"PAH",1,1,0) ^^2^2^3210427 "PKG",16,22,1,"PAH",1,1,1,0) Patch SD*5.3*786 will unschedule and mark out of order the "PKG",16,22,1,"PAH",1,1,2,0) SD EWL Background Job [SD EWL BACKGROUND JOB]. "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","SD53786P") 0^1^B1725151^n/a "RTN","SD53786P",1,0) SD53786P ;MNT/BJR - UUNSCHEDULE EWL BACKGROUND ; Apr 26, 2021@12:47 "RTN","SD53786P",2,0) ;;5.3;Scheduling;**786**;Aug 13, 1993;Build 3 "RTN","SD53786P",3,0) ; "RTN","SD53786P",4,0) Q "RTN","SD53786P",5,0) ;References to RESCH^XUTMOPT supported by DBIA #1472 "RTN","SD53786P",6,0) ;References to OUT^XPDPROT supported by DBIA #5567 "RTN","SD53786P",7,0) ;References to BMES^XPDUTL supported by DBIA #10141 "RTN","SD53786P",8,0) ; "RTN","SD53786P",9,0) ;Post-init routine to add new option to primary menu "RTN","SD53786P",10,0) ; "RTN","SD53786P",11,0) ; "RTN","SD53786P",12,0) EN ;Entry point for SD*5.3*786 Post Install routine "RTN","SD53786P",13,0) D DISOPT "RTN","SD53786P",14,0) D UNSCHOPT "RTN","SD53786P",15,0) Q "RTN","SD53786P",16,0) DISOPT ;Disable Options "RTN","SD53786P",17,0) N SDOM,SDMN,SDTEXT "RTN","SD53786P",18,0) F SDOM=1:1 S SDMN=$P($TEXT(OPTLST+SDOM),";;",2) Q:SDMN="$$END" D "RTN","SD53786P",19,0) .D OUT^XPDMENU(SDMN,"DO NOT USE!! EWL DECOM - SD*5.3*786") "RTN","SD53786P",20,0) .S SDTEXT="The "_SDMN_" menu option has been disabled." D BMES^XPDUTL(SDTEXT) "RTN","SD53786P",21,0) Q "RTN","SD53786P",22,0) UNSCHOPT ;Unschedule Option "RTN","SD53786P",23,0) N SDOM,SDMN,SDTEXT "RTN","SD53786P",24,0) F SDOM=1:1 S SDMN=$P($TEXT(OPTLST+SDOM),";;",2) Q:SDMN="$$END" D "RTN","SD53786P",25,0) .D RESCH^XUTMOPT(SDMN,"@",,"@") "RTN","SD53786P",26,0) .S SDTEXT="The "_SDMN_" menu option has been unscheduled." D BMES^XPDUTL(SDTEXT) "RTN","SD53786P",27,0) Q "RTN","SD53786P",28,0) OPTLST ;Options to Disable "RTN","SD53786P",29,0) ;;SD EWL BACKGROUND JOB "RTN","SD53786P",30,0) ;;$$END "RTN","SDWLQSC") 0^2^B65491758^B65234580 "RTN","SDWLQSC",1,0) SDWLQSC ;IOFO BAY PINES/TEH,DMR - WAITING LIST-SC PRIORITY BACKGROUND ; Apr 26, 2021@12:47 "RTN","SDWLQSC",2,0) ;;5.3;scheduling;**327,394,467,446,786**;AUG 13, 1993;Build 3 "RTN","SDWLQSC",3,0) ; "RTN","SDWLQSC",4,0) ;SD*5.3*327 EWL Updates Phase II - Addition of EWL notification messages. "RTN","SDWLQSC",5,0) ;SD*5.3*394 New Routine for background update of SDWL(409.3) SC priorities. "RTN","SDWLQSC",6,0) ;SD*5.3*467 Match canceled appts in 409.3 "RTN","SDWLQSC",7,0) ;This routine will run as a background job to determine changes in SC disabilities and update "RTN","SDWLQSC",8,0) ;the priority of the wait list visit. A mailman message will then be sent to the EWL mail group. "RTN","SDWLQSC",9,0) ;Vars: SDWLDFN=EWL IEN "RTN","SDWLQSC",10,0) ; SDWLSC1=EWL RECORDED SC % "RTN","SDWLQSC",11,0) ; SDWLSC2=PATIENT FILE (2) CURRENT SC % "RTN","SDWLQSC",12,0) ;DBIAs: 1476 reference to PRIMARY ELIG. ^DPT(IEN,.372) "RTN","SDWLQSC",13,0) ; 427 reference to ^DIC(8) "RTN","SDWLQSC",14,0) Q "RTN","SDWLQSC",15,0) EN ;Use SDWL(409.3) to determine SC changes and priority. "RTN","SDWLQSC",16,0) Q ;Inactive - SD*5.3*786 "RTN","SDWLQSC",17,0) S SDWLDFN=0 F S SDWLDFN=$O(^SDWL(409.3,"B",SDWLDFN)) Q:SDWLDFN<1 D "RTN","SDWLQSC",18,0) .S SDWLDA=0,SDWLME=0 F S SDWLDA=$O(^SDWL(409.3,"B",SDWLDFN,SDWLDA)) Q:SDWLDA="" D "RTN","SDWLQSC",19,0) ..L +^SDWL(409.3,SDWLDA):$G(DILOCKTM,5) I '$T Q "RTN","SDWLQSC",20,0) ..I $P($G(^SDWL(409.3,SDWLDA,0)),U,17)["C" Q ;I EWL entry has been 'CLOSED' don't process. "RTN","SDWLQSC",21,0) ..S SDWLME=SDWLME+1 "RTN","SDWLQSC",22,0) ..S SDWLSC1=+$P($G(^SDWL(409.3,SDWLDA,"SC")),U,1) "RTN","SDWLQSC",23,0) ..S SDWLSC2=+$$GET1^DIQ(2,SDWLDFN_",",.302,,"SDWLX","") "RTN","SDWLQSC",24,0) ..I SDWLSC1=SDWLSC2 S SDWLSC4=1 Q "RTN","SDWLQSC",25,0) ..S SDWLSCX=0,SDWLSC3=0,SDWLSC4=0 "RTN","SDWLQSC",26,0) ..I SDWLSC2<50,SDWLSC1>49 D "RTN","SDWLQSC",27,0) ...S SDWLSC3=1,SDWLSC4=1,DA=SDWLDA,DR="14////^S X=SDWLSC2",DIE=409.3 D ^DIE,SET1 "RTN","SDWLQSC",28,0) ..I SDWLSC2>49,SDWLSC1>49 S SDWLSCX=SDWLSC2 D SET0 Q "RTN","SDWLQSC",29,0) ..I SDWLSC2>49,SDWLSC1<50 S SDWLSCX=SDWLSC2 D SET0,SET1 Q "RTN","SDWLQSC",30,0) ..I SDWLSC2<50,SDWLSC1<50 S SDWLSC3=1,SDWLSC4=1,SDWLSCX=SDWLSC2 D SET0,SET1 Q "RTN","SDWLQSC",31,0) ..I '$D(^SDWL(409.3,SDWLDA,"SC")) D "RTN","SDWLQSC",32,0) ...I SDWLSC2>49 S SDWLSCX=SDWLSC2 D SET0,SET1 Q ;Set "SC" node if not defined. "RTN","SDWLQSC",33,0) ...I SDWLSC2<50 S SDWLSC3=1,SDWLSC4=1,DA=SDWLDA,DR="14////^S X=SDWLSC2",DIE=409.3 D ^DIE,SET1 "RTN","SDWLQSC",34,0) ..K SDWLSSN,SDWLSC2,SDWLSC1,SDWLSC3,SDWLSCP,SDWLX,SDWLI,SDWLSCX "RTN","SDWLQSC",35,0) ..L -^SDWL(409.3,SDWLDA) Q "RTN","SDWLQSC",36,0) I $D(SDWLSC4),SDWLSC4 D "RTN","SDWLQSC",37,0) .I $D(^TMP("SDWLQSC2",$J)) D MESS1^SDWLMSG "RTN","SDWLQSC",38,0) I $D(^TMP("SDWLQSC1",$J)) D MESS^SDWLMSG "RTN","SDWLQSC",39,0) K SDWLDA,SDWLDFN,SDWLSC1,SDWLSC2,SDWLSC3,SDWLSC4,DA,DR,DIC,DIE,X,SDWLX,SDWLNAM,SDWLSSN,SDWLSCX,SDWLWRT,SDWLME "RTN","SDWLQSC",40,0) D EN2^SDWLQSC1 D EN3 "RTN","SDWLQSC",41,0) K IEN,DFN,APPT,WLAPPT,STOP,WLSTAT,STATUS,NN,SDREC,SDARRAY,SDAPPT,CL,CLINIC,SDC,SDDFN,SDNAME,SDAPPST,CIEN,SDWL "RTN","SDWLQSC",42,0) K SDCL,SDIEN,CC,SDREACT,SDINACT,CLINICS,TEAM,TEAMN,WLOPEN,PIEN,POS,POSN,SDWLPOS,EDATE,DOD,DIS,NAME,MAX,AVAL,SDFORM "RTN","SDWLQSC",43,0) Q "RTN","SDWLQSC",44,0) SET0 ;Set EWL file with current SC percentage. "RTN","SDWLQSC",45,0) S DA=SDWLDA,DR="14////^S X=SDWLSCX",DIE=409.3 D ^DIE "RTN","SDWLQSC",46,0) I SDWLSC2=50!(SDWLSC2>50) S DR="15////^S X=1" D ^DIE "RTN","SDWLQSC",47,0) K DA,DR,X,DIE "RTN","SDWLQSC",48,0) Q "RTN","SDWLQSC",49,0) SET1 ;Set temporary file for message. "RTN","SDWLQSC",50,0) F SDWLI=.01,.09 S SDWLX(SDWLI)=$$GET1^DIQ(2,SDWLDFN_",",SDWLI,,"SDWLX","") "RTN","SDWLQSC",51,0) S SDWLNAM=$E($G(SDWLX(.01)),1,27),SDWLSSN=$E($G(SDWLX(.09)),6,99) "RTN","SDWLQSC",52,0) S SDWLSCP=$$GET1^DIQ(409.3,SDWLDA_",",15,,"SDWLSCP","") "RTN","SDWLQSC",53,0) S SDWLWRT=SDWLNAM,SDWLWRT=SDWLWRT_$J(SDWLSSN,(35-$L(SDWLNAM))) "RTN","SDWLQSC",54,0) S SDWLWRT=SDWLWRT_$J(SDWLSC1,8),SDWLWRT=SDWLWRT_$J(SDWLSC2,16-$L(SDWLSC1)) "RTN","SDWLQSC",55,0) I 'SDWLSC3 S SDWLWRT=SDWLWRT_$J(SDWLSCP,15) "RTN","SDWLQSC",56,0) I SDWLSC3 S SDWLWRT=SDWLWRT_$J($S(SDWLME>1:"YES",1:"NO"),15) "RTN","SDWLQSC",57,0) I SDWLSC3 S ^TMP("SDWLQSC2",$J,SDWLDFN)=SDWLWRT Q "RTN","SDWLQSC",58,0) S ^TMP("SDWLQSC1",$J,SDWLDFN)=SDWLWRT "RTN","SDWLQSC",59,0) Q "RTN","SDWLQSC",60,0) APPT(CLINIC,IEN) ; "RTN","SDWLQSC",61,0) S (SDREC,SDARRAY)="" "RTN","SDWLQSC",62,0) S SDARRAY(1)=WLAPPT_";"_WLAPPT "RTN","SDWLQSC",63,0) S SDARRAY(4)=DFN "RTN","SDWLQSC",64,0) S SDARRAY("FLDS")="3;2;4;1" "RTN","SDWLQSC",65,0) S SDREC=$$SDAPI^SDAMA301(.SDARRAY) "RTN","SDWLQSC",66,0) IF SDREC>0 D "RTN","SDWLQSC",67,0) .S (CL,SDC,SDDFN,SDNAM,SDAPPT,SDAPPST,NN)="" "RTN","SDWLQSC",68,0) .S CL=$O(^TMP($J,"SDAMA301",DFN,"")) Q:CL="" ;Current Clinic "RTN","SDWLQSC",69,0) .S SDAPPST=$P($G(^TMP($J,"SDAMA301",DFN,CL,WLAPPT)),"^",3),SDAPPST=$P(SDAPPST,";") ;Appt Status "RTN","SDWLQSC",70,0) .I CL'=CLINIC!(SDAPPST="CC") D "RTN","SDWLQSC",71,0) ..S SDDFN=$P($G(^TMP($J,"SDAMA301",DFN,CL,WLAPPT)),"^",4) IF SDDFN'="" S SDNAM=$P($G(SDDFN),";",2),SDNAM=$E(SDNAM,1,30) "RTN","SDWLQSC",72,0) ..S SDC=$P($G(^TMP($J,"SDAMA301",DFN,CL,WLAPPT)),"^",2) "RTN","SDWLQSC",73,0) ..S SDC=$$GET1^DIQ(44,CL_",",.01),SDC=$E(SDC,1,25) "RTN","SDWLQSC",74,0) ..S Y=WLAPPT D DD^%DT S SDAPPT=Y "RTN","SDWLQSC",75,0) ..IF CL'=CLINIC S SDC=SDC_"(new)" ;to distinguish another clinic" "RTN","SDWLQSC",76,0) ..S SDFORM=$$FORM^SDFORM(SDNAM,32,SDC,27,SDAPPT,21) "RTN","SDWLQSC",77,0) ..S NN=NN+1,^TMP("SDWLQSC3",$J,NN)=SDFORM "RTN","SDWLQSC",78,0) ..S DIE="^SDWL(409.3,",DA=IEN,DR="23////^S X=""O""" D ^DIE "RTN","SDWLQSC",79,0) ..S DR="13.8////^S X=""CC""" D ^DIE "RTN","SDWLQSC",80,0) ..S DR="29////^S X=""CA""" D ^DIE "RTN","SDWLQSC",81,0) ..S DR="19///@;20///@;21///@" D ^DIE "RTN","SDWLQSC",82,0) ..S DR="13///@;13.1////@;13.2///@;13.3///@;13.4///@;13.5///@;13.6///@;13.8///@;13.7///@" D ^DIE ;SD/467 "RTN","SDWLQSC",83,0) Q "RTN","SDWLQSC",84,0) EN3 ;Inactive clinics "RTN","SDWLQSC",85,0) S (CIEN,IEN,APPT,DFN,WLSTAT,SDCL,SDIEN,CC,SDREACT,SDINACT,CLINICS,SDFORM)="" "RTN","SDWLQSC",86,0) F S CIEN=$O(^SDWL(409.3,"SC",CIEN)) Q:CIEN<1 S CC=0 D "RTN","SDWLQSC",87,0) .S SDINACT=$$GET1^DIQ(44,CIEN_",",2505,"I"),SDREACT=$$GET1^DIQ(44,CIEN_",",2506,"I") "RTN","SDWLQSC",88,0) .Q:SDINACT=""&(SDREACT="") D "RTN","SDWLQSC",89,0) ..S IEN="" F S IEN=$O(^SDWL(409.3,"SC",CIEN,IEN)) Q:IEN<1 S WLSTAT=$$GET1^DIQ(409.3,IEN_",",23,"I") D "RTN","SDWLQSC",90,0) ...Q:WLSTAT'="O" "RTN","SDWLQSC",91,0) ...Q:SDINACTDT) "RTN","SDWLQSC",92,0) ...Q:SDINACTSDINACT) "RTN","SDWLQSC",93,0) ...Q:SDINACT>(DT+.01) "RTN","SDWLQSC",94,0) ...S CC=CC+1 "RTN","SDWLQSC",95,0) .IF CC>0 D "RTN","SDWLQSC",96,0) ..S CLINIC=$$GET1^DIQ(44,CIEN_",",.01),CLINIC=$E(CLINIC,1,30) "RTN","SDWLQSC",97,0) ..S SDFORM=$$FORM^SDFORM(CLINIC,40,CC,20),^TMP("SDWLQSC4",$J,CIEN)=SDFORM "RTN","SDWLQSC",98,0) ..S REC="",REC=$O(^SDWL(409.32,"B",CIEN,REC),-1) "RTN","SDWLQSC",99,0) ..IF REC'="" D "RTN","SDWLQSC",100,0) ...S SDINACT=$$GET1^DIQ(44,CIEN_",",2505,"I") "RTN","SDWLQSC",101,0) ...S DIE="^SDWL(409.32,",DA=REC,DR="3////^S X=SDINACT" D ^DIE "RTN","SDWLQSC",102,0) ...S DR="4////^S X=.5" D ^DIE "RTN","SDWLQSC",103,0) IF $D(^TMP("SDWLQSC4",$J)) D MESS3^SDWLMSG "RTN","SDWLQSC",104,0) D EN4 "RTN","SDWLQSC",105,0) Q "RTN","SDWLQSC",106,0) EN4 ;PCMM Team inactivated "RTN","SDWLQSC",107,0) S (IEN,TIEN,TEAM,TEAMN,DFN,CC,STATUS,WLOPEN,SDFORM)="" S CC="0" "RTN","SDWLQSC",108,0) F S TEAM=$O(^SDWL(409.3,"D",TEAM)) Q:TEAM<1 S CC=0 D "RTN","SDWLQSC",109,0) .S IEN="" F S IEN=$O(^SDWL(409.3,"D",TEAM,IEN)) Q:IEN<1 S WLOPEN=$$GET1^DIQ(409.3,IEN_",",23,"I") D "RTN","SDWLQSC",110,0) ..Q:WLOPEN="C" S TIEN="",TIEN=$O(^SCTM(404.58,"B",TEAM,TIEN),-1) IF TIEN'="" D "RTN","SDWLQSC",111,0) ...S STATUS=$$GET1^DIQ(404.58,TIEN_",",.03,"I") "RTN","SDWLQSC",112,0) ...Q:STATUS="1" "RTN","SDWLQSC",113,0) ...IF STATUS="0" S CC=CC+1 "RTN","SDWLQSC",114,0) .IF CC>0 D "RTN","SDWLQSC",115,0) ..S TEAMN=$$GET1^DIQ(404.51,TEAM_",",.01) S TEAMN=$E(TEAMN,1,30) "RTN","SDWLQSC",116,0) ..S SDFORM=$$FORM^SDFORM(TEAMN,40,CC,20),^TMP("SDWLQSC5",$J,TEAM)=SDFORM "RTN","SDWLQSC",117,0) IF $D(^TMP("SDWLQSC5",$J)) D MESS4^SDWLMSG "RTN","SDWLQSC",118,0) D EN5 "RTN","SDWLQSC",119,0) Q "RTN","SDWLQSC",120,0) EN5 ;PCMM Position inactivated "RTN","SDWLQSC",121,0) S (IEN,PIEN,POS,POSN,STATUS,WLOPEN,SDWLPOS,SDFORM,TEAM)="" "RTN","SDWLQSC",122,0) S SDWLPOS="" F S IEN=$O(^SDWL(409.3,"SP",IEN)) Q:IEN<1 D "RTN","SDWLQSC",123,0) .S POS="" F S POS=$O(^SDWL(409.3,"SP",IEN,POS)) Q:POS<1 D "RTN","SDWLQSC",124,0) ..S WLOPEN=$$GET1^DIQ(409.3,IEN_",",23,"I") "RTN","SDWLQSC",125,0) ..Q:WLOPEN="C" "RTN","SDWLQSC",126,0) ..S PIEN="",PIEN=$O(^SCTM(404.59,"B",POS,PIEN),-1) IF PIEN'="" D "RTN","SDWLQSC",127,0) ... S POSN=$$GET1^DIQ(404.57,POS_",",.01) "RTN","SDWLQSC",128,0) ...IF PIEN'="" S STATUS=$$GET1^DIQ(404.59,PIEN_",",.03,"I") "RTN","SDWLQSC",129,0) ...Q:STATUS="1" "RTN","SDWLQSC",130,0) ...IF STATUS="0" D "RTN","SDWLQSC",131,0) ....S:'$D(SDWLPOS(POS)) SDWLPOS(POS)=0 S SDWLPOS(POS)=SDWLPOS(POS)+1,POSN=$E(POSN,1,30) "RTN","SDWLQSC",132,0) ....S TEAM=$$GET1^DIQ(404.57,POS_",",.02),TEAM=$E(TEAM,1,25) "RTN","SDWLQSC",133,0) ....S SDFORM=$$FORM^SDFORM(POSN,32,TEAM,27,SDWLPOS(POS),21) "RTN","SDWLQSC",134,0) ....S ^TMP("SDWLQSC6",$J,POS)=SDFORM "RTN","SDWLQSC",135,0) IF $D(^TMP("SDWLQSC6",$J)) D MESS5^SDWLMSG "RTN","SDWLQSC",136,0) D EN6 "RTN","SDWLQSC",137,0) Q "RTN","SDWLQSC",138,0) EN6 ;Date of Death "RTN","SDWLQSC",139,0) S (IEN,SDDFN,DIS,DOD,NAME)="" "RTN","SDWLQSC",140,0) F S SDDFN=$O(^SDWL(409.3,"B",SDDFN)) Q:SDDFN<1 D "RTN","SDWLQSC",141,0) .S IEN="" F S IEN=$O(^SDWL(409.3,"B",SDDFN,IEN)) Q:IEN<1 D "RTN","SDWLQSC",142,0) ..S DIS=$$GET1^DIQ(409.3,IEN_",",21,"I") IF DIS="D" D "RTN","SDWLQSC",143,0) ...S DOD=$$GET1^DIQ(2,SDDFN_",",.351) Q:DOD'="" D "RTN","SDWLQSC",144,0) ....S DIE="^SDWL(409.3,",DA=IEN,DR="23////^S X=""O""" D ^DIE "RTN","SDWLQSC",145,0) ....S DR="19///@" D ^DIE "RTN","SDWLQSC",146,0) ....S DR="20///@" D ^DIE "RTN","SDWLQSC",147,0) ....S DR="21///@" D ^DIE "RTN","SDWLQSC",148,0) ....S DR="29////^S X=""DE""" D ^DIE "RTN","SDWLQSC",149,0) ....S NAME=$$GET1^DIQ(2,SDDFN_",",.01) S ^TMP("SDWLQSC7",$J,SDDFN)=NAME "RTN","SDWLQSC",150,0) IF $D(^TMP("SDWLQSC7",$J)) D MESS6^SDWLMSG "RTN","SDWLQSC",151,0) D EN7 "RTN","SDWLQSC",152,0) Q "RTN","SDWLQSC",153,0) EN7 ;PCMM Team open slots "RTN","SDWLQSC",154,0) S (IEN,TIEN,TEAMN,CC,WLOPEN,MAX,AVAL,SDFORM,TEAM,STATUS)="" "RTN","SDWLQSC",155,0) F S TEAM=$O(^SDWL(409.3,"D",TEAM)) Q:TEAM<1 S CC=0 D "RTN","SDWLQSC",156,0) .S IEN="" F S IEN=$O(^SDWL(409.3,"D",TEAM,IEN)) Q:IEN<1 S WLOPEN=$$GET1^DIQ(409.3,IEN_",",23,"I") D "RTN","SDWLQSC",157,0) ..Q:WLOPEN="C" S CC=CC+1 "RTN","SDWLQSC",158,0) .IF CC>0 D "RTN","SDWLQSC",159,0) ..S TIEN="",TIEN=$O(^SCTM(404.58,"B",TEAM,TIEN),-1) IF TIEN'="" D "RTN","SDWLQSC",160,0) ...S STATUS=$$GET1^DIQ(404.58,TIEN_",",.03,"I") "RTN","SDWLQSC",161,0) ...Q:STATUS="0" "RTN","SDWLQSC",162,0) ...S MAX=$$GET1^DIQ(404.51,TEAM_",",.08) "RTN","SDWLQSC",163,0) ...S TEAMC=$$TEAMCNT^SCAPMCU1(TEAM,DT) "RTN","SDWLQSC",164,0) ...Q:(TEAMC+.01)>MAX S AVAL=MAX-TEAMC,TEAMN=$$GET1^DIQ(404.51,TEAM_",",.01) "RTN","SDWLQSC",165,0) ...S TEAMN=$E(TEAMN,1,30),SDFORM=$$FORM^SDFORM(TEAMN,35,AVAL,22,CC,12) "RTN","SDWLQSC",166,0) ...S ^TMP("SDWLQSC8",$J,TIEN)=SDFORM "RTN","SDWLQSC",167,0) IF $D(^TMP("SDWLQSC8",$J)) D "RTN","SDWLQSC",168,0) .S SDFORM=$$FORM^SDFORM("TEAM",35,"SLOTS AVAILIABLE",22,"EWL ENTRIES",12) "RTN","SDWLQSC",169,0) .S ^TMP("SDWLQSC8",$J,.06)=SDFORM "RTN","SDWLQSC",170,0) .D MESS7^SDWLMSG "RTN","SDWLQSC",171,0) D EN8 "RTN","SDWLQSC",172,0) Q "RTN","SDWLQSC",173,0) EN8 ;PCMM Position open slots "RTN","SDWLQSC",174,0) S (IEN,PIEN,POS,POSN,STATUS,WLOPEN,EDATE,SDWLPOS,SDWL,SDFORM)="" K SDWLPOS "RTN","SDWLQSC",175,0) S SDWLPOS="" F S IEN=$O(^SDWL(409.3,"SP",IEN)) Q:IEN<1 D "RTN","SDWLQSC",176,0) .S POS="" F S POS=$O(^SDWL(409.3,"SP",IEN,POS)) Q:POS<1 D "RTN","SDWLQSC",177,0) ..S PIEN="",PIEN=$O(^SCTM(404.59,"B",POS,PIEN),-1) IF PIEN'="" D "RTN","SDWLQSC",178,0) ...S STATUS=$$GET1^DIQ(404.59,PIEN_",",.03,"I") "RTN","SDWLQSC",179,0) ...S WLOPEN=$$GET1^DIQ(409.3,IEN_",",23,"I"),EDATE=$$GET1^DIQ(404.59,PIEN_",",.02,"I") "RTN","SDWLQSC",180,0) ...Q:WLOPEN="C" "RTN","SDWLQSC",181,0) ...Q:((EDATE+.01)MAX "RTN","SDWLQSC",187,0) .S TEAM=$$GET1^DIQ(404.57,POS_",",.02),TEAM=$E(TEAM,1,23) "RTN","SDWLQSC",188,0) .S AVAL=MAX-SDWL,POSN=$$GET1^DIQ(404.57,POS_",",.01) "RTN","SDWLQSC",189,0) .S POSN=$E(POSN,1,23),SDFORM=$$FORM^SDFORM(POSN,25,TEAM,25,AVAL,14,SDWLPOS(POS),11) "RTN","SDWLQSC",190,0) .S ^TMP("SDWLQSC9",$J,POS)=SDFORM "RTN","SDWLQSC",191,0) IF $D(^TMP("SDWLQSC9",$J)) D "RTN","SDWLQSC",192,0) .S SDFORM=$$FORM^SDFORM("POSITION",25,"TEAM",25,"SLOTS AVAIL",14,"EWL ENTRIES",11) "RTN","SDWLQSC",193,0) .S ^TMP("SDWLQSC9",$J,.06)=SDFORM "RTN","SDWLQSC",194,0) .D MESS8^SDWLMSG "RTN","SDWLQSC",195,0) Q "VER") 8.0^22.2 "BLD",12198,6) ^638 **END** **END**