| [613] | 1 | SDWLTR ;IOFO BAY PINES/DMR - WAIT LIST TRANSMISSION TO ACC;06/12/2002 ; 29 Aug 2002 2:54 PM ; Compiled April 12, 2007 09:51:10
|
|---|
| 2 | ;;5.3;scheduling;**270,420,446**;AUG 13 1993;Build 77
|
|---|
| 3 | Q
|
|---|
| 4 | INIT ;
|
|---|
| 5 | S (DFN,REC,WLNAMEF,WLNAMEL,WLNAMEM,WLNAME,WLNAMES,NAME,DOB,SEX,RACE,MT,MTT,SSN,SSNP,STATE,STA,ZCODE,COUNTY,CTY,PHONE,SERCON,HINS,POS,PEC,PECN,PECNN,MCAID,POW,PH,ENROLLN,ENROLL,PREFACN,PREFAC,J,JJ,INST,INSTN,CSTOP,STOP,CLINIC,INST,N,MN)=""
|
|---|
| 6 | S (SWIEN,ICNUM,WLREC,WLORDT,WLTYPE,WLTEAMN,WLTEAM,WLPOSN,WLPOS,WLSPECN,WLSPEC,WLCLN,WLCL,WL,WLC,WLS,WLPRI,WLREQ,WLREMOV,WLDNMOV,WLDOD,WLRDFD,WLESTA,WLDDOA,WLCSTA,HOLD,PCMNUM,PCMMT,PCMMP,VER,WL,VETS,NUM,CLN)=""
|
|---|
| 7 | S (WLD2,WLC2,WLI2,WLSC2,WLCS2,WLS2,WLAS2,WLSCP2,WLPRI2,WLA2)=""
|
|---|
| 8 | S VER="1.0",N=0,MN=0,INST=+DUZ(2)
|
|---|
| 9 | DATA ;Check for data and setup arrays.
|
|---|
| 10 | I +$P($G(^SDWL(409.31,0)),"^",4)>.5 D
|
|---|
| 11 | .S J=0 F S J=$O(^SDWL(409.31,"E",J)) Q:J="" D
|
|---|
| 12 | ..S JJ=0 F S JJ=$O(^SDWL(409.31,"E",J,JJ)) Q:JJ="" D
|
|---|
| 13 | ...S CSTOP="",CSTOP=^SDWL(409.31,+JJ,0)
|
|---|
| 14 | ...S ^TMP("409.31",$J,+J,+CSTOP)=""
|
|---|
| 15 | ...Q
|
|---|
| 16 | I +$P($G(^SDWL(409.32,0)),"^",4)>.5 D
|
|---|
| 17 | .S J=0 F S J=$O(^SDWL(409.32,"C",J)) Q:J="" D
|
|---|
| 18 | ..S JJ=0 F S JJ=$O(^SDWL(409.32,"C",J,JJ)) Q:JJ="" D
|
|---|
| 19 | ...S CLINIC="",CLINIC=$P($G(^SDWL(409.32,+JJ,0)),"^",1)
|
|---|
| 20 | ...S ^TMP("409.32",$J,+J,+CLINIC)=""
|
|---|
| 21 | ...Q
|
|---|
| 22 | I +$P($G(^SDWL(409.3,0)),"^",4)<1 D NODATA,KILL Q
|
|---|
| 23 | D START,MESS^SDWLTR1(.MN),NODATA,KILL
|
|---|
| 24 | Q
|
|---|
| 25 | START ;Loop 409.3, get DFN file 2 info.
|
|---|
| 26 | N SDWLREJN,SDWLSREM,SDWLINTR,SDWL120F,SDWLMULT,SDWLINTE,SDWLIDES ; sd/446
|
|---|
| 27 | F S DFN=$O(^SDWL(409.3,"B",DFN)) Q:DFN="" D
|
|---|
| 28 | .D DEM^VADPT
|
|---|
| 29 | .S (WLNAMEL,WLNAMEF,WLNAMEM,WLNAMES,WLNAME,NAME(1))="" S WLNAME("FILE")=2,WLNAME("IENS")=DFN,WLNAME("FIELD")=.01
|
|---|
| 30 | .S NAME(1)=$$HLNAME^XLFNAME(.WLNAME,"","^") S WLNAMEL=$P($G(NAME(1)),"^",1),WLNAMEF=$P($G(NAME(1)),"^",2),WLNAMEM=$P($G(NAME(1)),"^",3),WLNAMES=$P($G(NAME(1)),"^",4)
|
|---|
| 31 | .S NAME=WLNAMEL_"^"_WLNAMEF_"^"_WLNAMEM_" "_WLNAMES
|
|---|
| 32 | .S DOB="" S DOB=$P($G(VADM(3)),"^",1)
|
|---|
| 33 | .S SEX="" S SEX=$P($G(VADM(5)),"^",1)
|
|---|
| 34 | .S RACE="" S RACE=$P($G(VADM(8)),"^",1)
|
|---|
| 35 | .S (SSN,SSNP)="" S SSN=$P($G(VADM(2)),"^",1) I SSN["P" S SSNP="P",SSN=$E(SSN,1,9)
|
|---|
| 36 | .S (MT,MTT)="" S MT=$$LST^DGMTU(DFN,DT,1) I MT'="" S MTT=1,MT=$P($G(MT),"^",4)
|
|---|
| 37 | .I MT="" S MT=$$LST^DGMTU(DFN,DT,2) I MT'="" S MTT=2,MT=$P($G(MT),"^",4)
|
|---|
| 38 | .D ADD^VADPT
|
|---|
| 39 | .S (STATE,STA)="" S STA=$P($G(VAPA(5)),"^",1) D
|
|---|
| 40 | ..I STA'="" S STATE=$E("00",$L(STA)+1,2)_STA
|
|---|
| 41 | .S ZCODE="" S ZCODE=$G(VAPA(6))
|
|---|
| 42 | .S (COUNTY,CTY)="" S COUNTY=$P($G(VAPA(7)),"^",1) D
|
|---|
| 43 | ..I COUNTY'=""&(STATE'="") S CTY=$$GET1^DIQ(5.01,COUNTY_","_STATE,"VA COUNTY CODE") D
|
|---|
| 44 | ...S COUNTY="" I CTY'="" S COUNTY=STATE_CTY
|
|---|
| 45 | .S PHONE="" S PHONE=$G(VAPA(8))
|
|---|
| 46 | .S SERCON="" S SERCON=$$GET1^DIQ(2,DFN_",",.302)
|
|---|
| 47 | .S HINS="" S HINS=$$GET1^DIQ(2,DFN_",",.3192,"I")
|
|---|
| 48 | .S (POSN,POS)="" S POSN=$$GET1^DIQ(2,DFN_",",.323,"I") I POSN'="" S POS=$$GET1^DIQ(21,POSN_",",.03)
|
|---|
| 49 | .S (PEC,PECN,PECNN)="" S PECN=$$GET1^DIQ(2,DFN_",",.361,"I") I PECN'="" S PECNN=$$GET1^DIQ(8,PECN_",",8,"I") I PECNN'="" S PEC=$$GET1^DIQ(8.1,PECNN_",",3)
|
|---|
| 50 | .S VETS="" S VETS=$$GET1^DIQ(2,DFN_",",1901,"I")
|
|---|
| 51 | .S MCAID="" S MCAID=$$GET1^DIQ(2,DFN_",",.381,"I"),MCAID=$S(MCAID=1:"Y",MCAID=0:"N",1:"")
|
|---|
| 52 | .S POW="" S POW=$$GET1^DIQ(2,DFN_",",.525,"I")
|
|---|
| 53 | .S PH="" S PH=$$GET1^DIQ(2,DFN_",",.531,"I")
|
|---|
| 54 | .S (ENROLLN,ENROLL,ENROLSUB)="" S ENROLLN=$$GET1^DIQ(2,DFN_",",27.01,"I") I ENROLLN'="" S ENROLL=$$GET1^DIQ(27.11,ENROLLN_",",.01,"I")
|
|---|
| 55 | .S ENROLLP="" I ENROLLN'="" S ENROLLP=$$GET1^DIQ(27.11,ENROLLN_",",.07,"I") I ENROLLP D
|
|---|
| 56 | ..S ENROLSUB=$$GET1^DIQ(27.11,ENROLLN_",",.12) I ENROLSUB'="" S ENROLLP=ENROLLP_ENROLSUB
|
|---|
| 57 | .S (PREFACN,PREFAC)="" S PREFACN=$$GET1^DIQ(2,DFN_",",27.02,"I") I PREFACN'="" S PREFAC=$$GET1^DIQ(4,PREFACN_",",99)
|
|---|
| 58 | .S ICNUM="" S ICNUM=$$GET1^DIQ(2,DFN_",",991.01)
|
|---|
| 59 | .S PCMNUM="" S PCMNUM=$P($$NMPCPR^SCAPMCU2(DFN,DT,1),"^",1) D
|
|---|
| 60 | ..I PCMNUM<0!(PCMNUM="") S PCMNUM="",PCMMP="^^"
|
|---|
| 61 | ..I PCMNUM>0 D
|
|---|
| 62 | ...S (PCMML,PCMMF,PCMMM,NAME(1),PCMMP)="" S PCMM("FILE")=200,PCMM("IENS")=PCMNUM,PCMM("FIELD")=.01
|
|---|
| 63 | ...S NAME(1)=$$HLNAME^XLFNAME(.PCMM,"","^") S PCMML=$P(NAME(1),"^",1),PCMMF=$P(NAME(1),"^",2),PCMMM=$P(NAME(1),"^",3)
|
|---|
| 64 | ...S PCMMP=PCMML_"^"_PCMMF_"^"_PCMMM
|
|---|
| 65 | .S PCMMT="" S PCMMT=$P($$NMPCTM^SCAPMCU2(DFN,DT,1),"^",2)
|
|---|
| 66 | .S SWIEN="" F S SWIEN=$O(^SDWL(409.3,"B",DFN,SWIEN)) Q:SWIEN="" D
|
|---|
| 67 | ..S (WLREC,WLORDT,WLTYPE,WLINSTN,WLTEAMN,WLTEAM,WLPOSN,WLPOS,WLSPECN,WLSPEC,WLCLN,WLCL,WLPRI,WLREQ)=""
|
|---|
| 68 | ..S (WLREMOV,WLDNMOV,WLDOD,WLRDFD,WLDDOA,WLESTA,WLCSTA,WLPHY,WLPCMT,WLINST,INSTN,WL,WLC,WLS,NUM)=""
|
|---|
| 69 | ..S (WLA2,WLD2,WLC2,WLI2,WLSC2,WLCS2,WLS2,WLCL2,WLAS2,WLSCP2,WLPRI2,WLROR2,WLROC2)=""
|
|---|
| 70 | ..S WLREC=^SDWL(409.3,SWIEN,0)
|
|---|
| 71 | ..S WLORDT=$P(WLREC,"^",2)
|
|---|
| 72 | ..S WLTYPE=$P(WLREC,"^",5)
|
|---|
| 73 | ..S WLINSTN=$P(WLREC,"^",3) I WLINSTN'="" S X=$$GET1^DIQ(4,+WLINSTN_",",99),WLINST=$P(X,U,1),INSTN=$$GET1^DIQ(4,+WLINSTN_",",.01)
|
|---|
| 74 | ..S WLTEAMN=$P(WLREC,"^",6) I WLTEAMN'="" S WLTEAM=$P($G(^SCTM(404.51,WLTEAMN,0)),"^",1)
|
|---|
| 75 | ..S WLPOSN=$P(WLREC,"^",7) I WLPOSN'="" S WLPOS=$P($G(^SCTM(404.57,WLPOSN,0)),"^",1)
|
|---|
| 76 | ..S WLSPECN=$P(WLREC,"^",8) I WLSPECN'="" S WLS=$G(^SDWL(409.31,WLSPECN,0)),WLSPEC=$$GET1^DIQ(40.7,WLS_",",1)
|
|---|
| 77 | ..S WLCLN=$P(WLREC,"^",9) I WLCLN'="" S WLC=$P(^SDWL(409.32,WLCLN,0),"^",1),WLCL=$P($G(^SC(WLC,0)),"^",1) D
|
|---|
| 78 | ...I WLC'="" S NUM=$E("000000",$L(WLC)+1,6)_WLC
|
|---|
| 79 | ..I WLSPECN=""&(WLCLN'="") S WL=$P(^SDWL(409.32,WLCLN,0),"^",1),WLSPECN=$P($G(^SC(WL,0)),"^",7),WLSPEC=$$GET1^DIQ(40.7,WLSPECN_",",1)
|
|---|
| 80 | ..S WLPRI=$P(WLREC,"^",11)
|
|---|
| 81 | ..S WLREQ=$P(WLREC,"^",12)
|
|---|
| 82 | ..S WLREMOV=$P(WLREC,"^",14)
|
|---|
| 83 | ..S WLDNMOV=$P($G(^SDWL(409.3,SWIEN,"DNR")),"^",1),WLDOD=$P($G(^SDWL(409.3,SWIEN,"DIS")),"^",1),WLRDFD=$P($G(^SDWL(409.3,SWIEN,"DIS")),"^",3)
|
|---|
| 84 | ..S WLDDOA=$P(WLREC,"^",16),WLCSTA=$P(WLREC,"^",17),WLESTA=$P(WLREC,"^",20)
|
|---|
| 85 | ..I $P($G(WLREC),"^",23)'=""&($D(^SDWL(409.3,SWIEN,"SDAPT"))) S WLA2=$P(WLREC,"^",23),WLREC2=^SDWL(409.3,SWIEN,"SDAPT") D
|
|---|
| 86 | ...S WLD2=$P($G(WLREC2),"^",1),WLC2=$$GET1^DIQ(409.3,SWIEN_",",13.2),WLI2=$$GET1^DIQ(409.3,SWIEN_",",13.3),WLSC2=$P($G(WLREC2),"^",4),WLCS2=$$GET1^DIQ(409.3,SWIEN_",",13.5)
|
|---|
| 87 | ...S WLS2=$P($G(WLREC2),"^",6),WLAS2=$P($G(WLREC2),"^",8),WLCL2=$$GET1^DIQ(409.3,SWIEN_",",13.7),WLROC2=$$GET1^DIQ(409.3,SWIEN_",",30)
|
|---|
| 88 | ...S WLSCP2=$P($G(^SDWL(409.3,SWIEN,"SC")),"^",1),WLPRI2=$P($G(^SDWL(409.3,SWIEN,"SC")),"^",2),WLROR2=$$GET1^DIQ(409.3,SWIEN_",",29,"I")
|
|---|
| 89 | ...S WLROC2=$$GET1^DIQ(409.3,SWIEN_",",30)
|
|---|
| 90 | ..D FLAGS^SDWLTR1(SWIEN,.SDWLREJN,.SDWLSREM,.SDWLINTR,.SDWL120F,.SDWLMULT,.SDWLINTE,.SDWLIDES) ; sd/446
|
|---|
| 91 | ..Q:SWIEN=HOLD D
|
|---|
| 92 | ...D CHECK
|
|---|
| 93 | ...I N>39 D MESS^SDWLTR1(.MN) K ^TMP("EWL",$J) S N=0
|
|---|
| 94 | ...S N=N+1
|
|---|
| 95 | ...S ^TMP("EWL",$J,SWIEN_N,0)="#"_WLINST_"^"_VER_"^"_INSTN_"^"_WLCL_"^"_NUM_"^"_WLSPEC_"^"_WLTYPE_"^"_NAME_"^"_DFN_"^"_DOB_"^"_SEX_"^"_RACE_"^"_SSN_"^"_SSNP_"^"_STATE_"^"_COUNTY_"^"_ZCODE_"^"_PHONE
|
|---|
| 96 | ...S ^TMP("EWL",$J,SWIEN_N,0)=^TMP("EWL",$J,SWIEN_N,0)_"^"_MT_"^"_MTT_"^"_SERCON_"^"_HINS_"^"_POS_"^"_PEC_"^"_VETS_"^"_MCAID_"^"_POW_"^"_PH_"^"_ENROLL_"^"_ENROLLP_"^"_PREFAC
|
|---|
| 97 | ...S ^TMP("EWL",$J,SWIEN_N,0)=^TMP("EWL",$J,SWIEN_N,0)_"^"_ICNUM_"^"_PCMNUM_"^"_PCMMP_"^"_PCMMT_"^"_WLORDT_"^"_WLTEAM_"^"_WLPOS_"^"_WLPRI_"^"_WLREQ_"^"_WLDOD_"^"_WLRDFD_"^"_WLDDOA_"^"_WLCSTA_"^"_WLESTA_"^"_WLREMOV_"^"_WLDNMOV
|
|---|
| 98 | ...S ^TMP("EWL",$J,SWIEN_N,0)=^TMP("EWL",$J,SWIEN_N,0)_"^"_WLA2_"^"_WLD2_"^"_WLC2_"^"_WLI2_"^"_WLSC2_"^"_WLCS2_"^"_WLS2_"^"_WLCL2_"^"_WLAS2_"^"_WLSCP2_"^"_WLPRI2_"^"_WLROR2
|
|---|
| 99 | ...S ^TMP("EWL",$J,SWIEN_N,0)=^TMP("EWL",$J,SWIEN_N,0)_"^"_WLROC2_"^"_SDWLREJN_"^"_SDWLSREM_"^"_SDWLINTR_"^"_SDWL120F_"^"_SDWLMULT_"^"_SDWLINTE_"^"_SDWLIDES_"^$" ; sd/446
|
|---|
| 100 | ...S HOLD=SWIEN
|
|---|
| 101 | ...Q
|
|---|
| 102 | Q
|
|---|
| 103 | NODATA ;No data in ^SDWL(409.3)
|
|---|
| 104 | S N=0,MN=MN+1
|
|---|
| 105 | I +$P($G(^SDWL(409.31,0)),"^",4)<1 D SET
|
|---|
| 106 | I +$P($G(^SDWL(409.32,0)),"^",4)<1 D SET
|
|---|
| 107 | I +$P($G(^SDWL(409.31,0)),"^",4)>.5 D SET2
|
|---|
| 108 | I +$P($G(^SDWL(409.32,0)),"^",4)>.5 D SET3
|
|---|
| 109 | MESS2 ;
|
|---|
| 110 | N XMSUB,XMY,XMTEXT,XMDUZ
|
|---|
| 111 | S XMSUB="EWL FILE TRANSMISSION"_" MESSAGE # "_MN
|
|---|
| 112 | S XMY("G.SD WAIT LIST TRANS TO AAC")=""
|
|---|
| 113 | S XMTEXT="^TMP(""EWL"",$J,"
|
|---|
| 114 | S XMDUZ="POSTMASTER"
|
|---|
| 115 | D ^XMD
|
|---|
| 116 | Q
|
|---|
| 117 | SET ;Save data if no pat. on wait list.
|
|---|
| 118 | S ^TMP("EWL",$J,INST,0)="#"_INST_"^"_1.1_"$"
|
|---|
| 119 | Q
|
|---|
| 120 | SET2 ;Set nodata global for ser/spec file 409.31
|
|---|
| 121 | S J=0 F S J=$O(^TMP("409.31",$J,J)) Q:J="" D
|
|---|
| 122 | .S JJ=0 F S JJ=$O(^TMP("409.31",$J,J,JJ)) Q:JJ="" D
|
|---|
| 123 | ..S (INSTN,NAME,CSTOP,CLN)="",CLINIC=0,CSTOP=$$GET1^DIQ(40.7,JJ_",",1),NAME=$$GET1^DIQ(4,J_",",.01),INSTN=$$GET1^DIQ(4,J_",",99) D SAVE
|
|---|
| 124 | ..Q
|
|---|
| 125 | Q
|
|---|
| 126 | SET3 ;Set nodata global for clinic file 409.32
|
|---|
| 127 | S J=0 F S J=$O(^TMP("409.32",$J,J)) Q:J="" D
|
|---|
| 128 | .S JJ=0 F S JJ=$O(^TMP("409.32",$J,J,JJ)) Q:JJ="" D
|
|---|
| 129 | ..S (INSTN,NAME,CSTOP,STOP,CLINIC,CLN)="",CLINIC=$P($G(^SC(JJ,0)),"^",1),CLN=JJ,NAME=$$GET1^DIQ(4,J_",",.01),INSTN=$$GET1^DIQ(4,J_",",99),STOP=$P($G(^SC(JJ,0)),"^",7),CSTOP=$$GET1^DIQ(40.7,STOP_",",1) D SAVE
|
|---|
| 130 | ..Q
|
|---|
| 131 | Q
|
|---|
| 132 | SAVE ;Save nodata info.
|
|---|
| 133 | S U="^",N=N+1,NUM=0 I CLN'="" S NUM=$E("000000",$L(CLN)+1,6)_CLN
|
|---|
| 134 | S ^TMP("EWL",$J,INST_N,0)="#"_INSTN_U_1.2_"^"_NAME_U_CLINIC_U_NUM_U_CSTOP_U_0_U_0_U_0_U_0_U_0_U_0_U_0_U_0_U_0_U_0_U_0_U_0_U_0_U_0_U
|
|---|
| 135 | S ^TMP("EWL",$J,INST_N,0)=^TMP("EWL",$J,INST_N,0)_0_U_0_U_0_U_0_U_0_U_0_U_0_U_0_U_0_U_0_U_0_U_0_U_0_U_0_U_0_U_0_U_0_U_0_U_0_U_0_U_0_U_0_U_0_U_0_U_0_U_0_U_0_U_0_U_0_U_0_U_0_U_"$"
|
|---|
| 136 | Q
|
|---|
| 137 | CHECK ;Deletes array entry if data for spec/cln/inst.
|
|---|
| 138 | I WLTYPE=3 D
|
|---|
| 139 | .I $D(^TMP("409.31",$J,+WLINSTN,+WLS)) K ^TMP("409.31",$J,+WLINSTN,+WLS)
|
|---|
| 140 | I WLTYPE=4 D
|
|---|
| 141 | .I $D(^TMP("409.32",$J,+WLINSTN,+WLC)) K ^TMP("409.32",$J,+WLINSTN,+WLC)
|
|---|
| 142 | Q
|
|---|
| 143 | KILL ;
|
|---|
| 144 | K ^TMP("EWL",$J),^TMP("409.31",$J),^TMP("409.32",$J)
|
|---|
| 145 | K DFN,REC,WLNAMEF,WLNAMEL,WLNAMEM,WLNAME,NAME,DOB,SEX,RACE,MT,MTT,SSN,SSNP,STATE,STA,ZCODE,COUNTY,CTY,PHONE,SERCON,HINS,POS,PEC,PECN,PECNN,MCAID,POW,PH,ENROLLN,ENROLL,PREFACN,PREFAC,J,JJ,INST,INSTN,CSTOP,STOP,CLINIC,INST,N,MN
|
|---|
| 146 | K SWIEN,ICNUM,WLREC,WLORDT,WLTYPE,WLTEAMN,WLTEAM,WLPOSN,WLPOS,WLSPECN,WLSPEC,WLCLN,WLCL,WL,WLC,WLS,WLPRI,WLREQ,WLREMOV,WLDNMOV,WLDOD,WLRDFD,WLESTA,WLDDOA,WLCSTA,HOLD,PCMNUM,PCMMT,PCMMP,VER,WL,VETS,NUM,CLN
|
|---|
| 147 | K ENROLL,ENROLLP,ENROLSUB,WLNAMES,WLD2,WLC2,WLI2,WLSC2,WLCS2,WLS2,WLCL2,WLAS2,WLSCP2,WLPRI2,WLA2,WLROR2,WLROC2,WLREC2,PCMM,PCMMF,PCMML,PCMMM,POSN,WLINST,WLINSTN,WLPCMT,WLPHY,X,VADM,VAPA
|
|---|
| 148 | Q
|
|---|
