Changeset 1036 for Scheduling/trunk/m
- Timestamp:
- Dec 8, 2010, 1:44:40 AM (14 years ago)
- Location:
- Scheduling/trunk/m
- Files:
-
- 3 edited
Legend:
- Unmodified
- Added
- Removed
-
Scheduling/trunk/m/BSDX26.m
r1034 r1036 1 BSDX26 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 1 1/18/10 5:36pm1 BSDX26 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 12/6/10 3:08am 2 2 ;;1.42;BSDX;;Sep 29, 2010 3 3 ; Change History: … … 34 34 D EDITAPT(.ZZZ,188,NOTE) 35 35 I +^BSDXTMP($J,1)'=-100 W "ERROR IN -100",! B 36 k bsdxdie 36 37 ; Test 5: Trestart 37 38 N bsdxrestart S bsdxrestart=1 … … 40 41 D EDITAPT(.ZZZ,188,NOTE) 41 42 I ^BSDXAPPT(188,1,1,0)'=NOTE W "ERROR in TRESTART",! B 42 ; Test for Hosp Location Update43 ; Test 6: for Hosp Location Update 43 44 N DATE S DATE=$$NOW^XLFDT() 45 S DATE=$E(DATE,1,12) ; Just get minutes b/c of HL file input transform 44 46 D APPADD^BSDX07(.ZZZ,DATE,DATE+.001,3,"Dr Office",30,"Old Note",1) 45 47 N APPID S APPID=+$P(^BSDXTMP($J,1),U) 46 D EDITAPT(.ZZZ,AP TID,"New Note")48 D EDITAPT(.ZZZ,APPID,"New Note") 47 49 I ^BSDXAPPT(APTID,1,1,0)'="New Note" W "Error in HL Section",! B 48 50 I $P(^SC(2,"S",DATE,1,1,0),U,4)'="New Note" W "Error in HL Section",! B -
Scheduling/trunk/m/BSDX29.m
r968 r1036 1 BSDX29 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/18/10 2:03pm2 ;;1.4 1;BSDX;;Sep 29, 20103 4 5 1 BSDX29 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 12/6/10 6:05am 2 ;;1.42;BSDX;;Sep 29, 2010 3 ; 4 ; Change Log: 5 ; v1.3 by WV/SMH on 3100713 6 6 ; - Beginning and Ending dates passed as FM Dates 7 ; v1.42 by WV/SMH on 3101023 8 ; - Transaction moved; now restartable too. 9 ; --> Thanks to Zach Gonzalez and Rick Marshall. 10 ; - Refactoring of major portions of routine 7 11 ; 8 12 BSDXCPD(BSDXY,BSDXRES,BSDX44,BSDXBEG,BSDXEND) ;EP 9 13 ;Entry point for debugging 10 14 ; 11 ;D DEBUG^%Serenji("BSDXCP^BSDX29(.BSDXY,BSDXRES,BSDX44,BSDXBEG,BSDXEND)")15 D DEBUG^%Serenji("BSDXCP^BSDX29(.BSDXY,BSDXRES,BSDX44,BSDXBEG,BSDXEND)") 12 16 Q 13 17 ; … … 15 19 ;Copy appointments from HOSPITAL LOCATION entry BSDX44 to BSDX RESOURCE entry BSDXRES 16 20 ;Beginning with appointments on day BSDXBEG and ending on BSDXEND, inclusive 17 ; 18 ;Returns ADO Recordset formatted fields containing count of records copied and error message: 19 ; 20 ; July 13 2010: D dates (BEG and END) from US format to FM Dates for i18n 21 ; 22 ; 23 S BSDXY="^BSDXTMP("_$J_")" 24 N BSDXI,BSDXST,ZTSK 25 S BSDXI=0 26 S X="ETRAP^BSDX29",@^%ZOSF("TRAP") 21 ;Called by RPC: BSDX COPY APPOINTMENTS 22 ; 23 ; Parameters: 24 ; - BSDXY: Global Return 25 ; - BSDXRES: BSDX RESOURCE to copy appointments to 26 ; - BSDX44: Hospital Location IEN to copy appointments from 27 ; - BSDXBEG: Beginning Date in FM Format 28 ; - BSDXEND: End Date in FM Format 29 ; 30 ;Returns ADO Recordset containing TASK_NUMBER and ERRORID 31 ; 32 ; Return Array 33 S BSDXY=$NA(^BSDXTMP($J)) 34 K ^BSDXTMP($J) 35 ; $ET 36 N $ET S $ET="G ETRAP^BSDX29" 37 ; Counter 38 N BSDXI S BSDXI=0 39 ; Header Node 27 40 S ^BSDXTMP($J,0)="T00010TASK_NUMBER^T00020ERRORID"_$C(30) 28 41 ; 29 ;Convert beginning and ending dates 30 ; 31 ;TODO:Validate FM Dates coming through 32 ; 33 S BSDXBEG=BSDXBEG-1 42 ; Make dates inclusive; add 1 to FM dates 43 S BSDXBEG=BSDXBEG-1 34 44 S BSDXEND=BSDXEND+1 35 45 ; 46 ; Taskman variables 47 N ZTSK,ZTRTN,ZTDTH,ZTDESC,ZTSAVE 48 ; Task Load 36 49 S ZTRTN="ZTM^BSDX29",ZTDTH=$H,ZTDESC="COPY PATIENT APPTS" 37 50 S ZTSAVE("BSDXBEG")="",ZTSAVE("BSDXEND")="",ZTSAVE("BSDX44")="",ZTSAVE("BSDXRES")="" 38 51 D ^%ZTLOAD 39 ; 40 S BSDXI=BSDXI+141 S BSDX ST=$S($G(ZTSK)>0:"OK",1:"Unable to create task.")52 ; Set up return ADO.net dataset 53 N BSDXST S BSDXST=$S($G(ZTSK)>0:"OK",1:"Unable to create task.") 54 S BSDXI=BSDXI+1 42 55 S ^BSDXTMP($J,BSDXI)=$G(ZTSK)_"^"_BSDXST_$C(30)_$C(31) 43 Q 44 ; 45 ZTMTST ; 46 ; 47 S %DT="AE" D ^%DT S BSDXBEG=Y 48 S %DT="AE" D ^%DT S BSDXEND=Y 49 S BSDX44=3,BSDXSRES=1,ZTSK=3380 50 D ZTM 51 Q 56 QUIT 52 57 ; 53 58 ZTMD ;EP - Debug entry point … … 55 60 Q 56 61 ; 57 ZTM ;EP 58 ;Taskman entry point 59 S X="ZTMERR^BSDX29",@^%ZOSF("TRAP") 62 ZTM ;EP - Taskman entry point 63 ; Variables set up in ZTSAVE above 64 ; 65 Q:'$D(ZTSK) 66 ; $ET 67 N $ET S $ET="G ZTMERR^BSDX29" 68 ; Txn 69 TSTART (BSDXBEG,BSDXEND,BSDX44,BSDXRES):T="BSDX COPY APPOINTMENT^BSDX29" 60 70 ;$O through ^SC(BSDX44,"S", 61 Q:'$D(ZTSK) 62 N BSDXCNT,BSDXIEN,BSDXNOD,BSDXNOTE,BSDXCAN,BSDXPAT,BSDXLEN,BSDXMADE,BSDXCLRK,BSDXPAT,BSDXQUIT 63 S BSDXCNT=0,BSDXQUIT=0 64 S ^BSDXTMP("BSDXCOPY",ZTSK)=BSDXCNT 65 TSTART 66 F S BSDXBEG=$O(^SC(BSDX44,"S",BSDXBEG)) Q:'+BSDXBEG Q:BSDXBEG>BSDXEND Q:BSDXQUIT D 67 . S BSDXIEN=0 F S BSDXIEN=$O(^SC(BSDX44,"S",BSDXBEG,1,BSDXIEN)) Q:'+BSDXIEN Q:BSDXQUIT D 68 . . S BSDXNOD=$G(^SC(BSDX44,"S",BSDXBEG,1,BSDXIEN,0)) 69 . . Q:'+BSDXNOD 70 . . S BSDXCAN=$P(BSDXNOD,U,9) 71 . . Q:BSDXCAN="C" 72 . . S BSDXPAT=$P(BSDXNOD,U) 73 . . S BSDXLEN=$P(BSDXNOD,U,2) ;duration in minutes 74 . . S BSDXCLRK=$P(BSDXNOD,U,6) ;appt made by (clerk) 75 . . S BSDXMADE=$P(BSDXNOD,U,7) ;date appt made 76 . . S BSDXNOTE=$P(BSDXNOD,U,4) ;'OTHER' field contains note 71 N BSDXCNT S BSDXCNT=0 ; Count of Copied Appointments 72 N BSDXQUIT S BSDXQUIT=0 ; Quit Flag to be retrieved from an external proc 73 ; Set Count 74 S ^BSDXTMP("BSDXCOPY",ZTSK)=BSDXCNT 75 ; Loop through dates here. 76 F S BSDXBEG=$O(^SC(BSDX44,"S",BSDXBEG)) Q:'+BSDXBEG Q:BSDXBEG>BSDXEND Q:BSDXQUIT D 77 . ; Loop through Entries in each date in the subsubfile. 78 . ; Quit if we are at the end or if a remote process requests a quit. 79 . N BSDXIEN S BSDXIEN=0 80 . F S BSDXIEN=$O(^SC(BSDX44,"S",BSDXBEG,1,BSDXIEN)) Q:'+BSDXIEN Q:BSDXQUIT D 81 . . N BSDXNOD S BSDXNOD=$G(^SC(BSDX44,"S",BSDXBEG,1,BSDXIEN,0)) ; Node 82 . . Q:'+BSDXNOD ; Quit if no node 83 . . N BSDXCAN S BSDXCAN=$P(BSDXNOD,U,9) ; Cancel flag 84 . . Q:BSDXCAN="C" ; Quit if appt cancelled 85 . . N BSDXPAT S BSDXPAT=$P(BSDXNOD,U) ; Patient 86 . . N BSDXLEN S BSDXLEN=$P(BSDXNOD,U,2) ;duration in minutes 87 . . N BSDXCLRK S BSDXCLRK=$P(BSDXNOD,U,6) ;appt made by (clerk) 88 . . N BSDXMADE S BSDXMADE=$P(BSDXNOD,U,7) ;date appt made 89 . . N BSDXNOTE S BSDXNOTE=$P(BSDXNOD,U,4) ;'OTHER' field contains note 77 90 . . S BSDXCNT=BSDXCNT+$$XFER(BSDXRES,BSDXBEG,BSDXPAT,BSDXLEN,BSDXCLRK,BSDXMADE,BSDXNOTE) 78 91 . . I +BSDXCNT,BSDXCNT#10=0 S ^BSDXTMP("BSDXCOPY",ZTSK)=BSDXCNT_" records copied." ;every 10th record … … 85 98 Q 86 99 ; 87 ZTMERR ; 88 TROLLBACK 100 ZTMERR ; For now, error from TM is only in trap; not returned to client. 101 N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap 102 ; Rollback before logging the error 103 I $TL>0 TROLLBACK 89 104 D ^%ZTER 90 Q 105 S $EC="" ; Clear Error 106 QUIT 91 107 ; 92 108 XFER(BSDXRES,BSDXBEG,BSDXPAT,BSDXLEN,BSDXCLRK,BSDXMADE,BSDXNOTE) ;EP … … 132 148 ERR(BSDXI,BSDXCNT,BSDXERR) ;Error processing 133 149 S BSDXI=BSDXI+1 150 S BSDXERR=$TR(BSDXERR,"^","~") 134 151 S ^BSDXTMP($J,BSDXI)=BSDXCNT_"^"_BSDXERR_$C(30) 135 152 S BSDXI=BSDXI+1 … … 138 155 ; 139 156 ETRAP ;EP Error trap entry 140 D ^%ZTER 141 I '$D(BSDXI) N BSDXI S BSDXI=999 142 S BSDXI=BSDXI+1 143 D ERR(BSDXI,$G(BSDXCNT),"Routine: BSDX29, Error: "_$G(%ZTERROR)) 144 Q 145 ; 146 CPSTAT(BSDXY,BSDXTSK) ;EP 157 ; No Txn here. So don't rollback anything 158 N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap 159 D ^%ZTER 160 S $EC="" ; Clear error 161 I '$D(BSDXI) N BSDXI S BSDXI=0 162 D ERR(BSDXI,$G(BSDXCNT),"~100~BSDX29, Error: "_$G(%ZTERZE)) 163 Q 164 ; 165 CPSTAT(BSDXY,BSDXTSK) ;EP - Note: As of Dec 6 2010: Inactive Code 147 166 ;Return status (copied record count) of tasked job having ZTSK=BSDXTSK 148 167 ; … … 160 179 Q 161 180 ; 162 CPCANC(BSDXY,BSDXTSK) ;EP 181 CPCANC(BSDXY,BSDXTSK) ;EP Note: As of Dec 6 2010: Inactive code. 163 182 ;Signal tasked job having ZTSK=BSDXTSK to cancel 164 183 ;Returns current record count of copy process -
Scheduling/trunk/m/BSDX31.m
r968 r1036 1 BSDX31 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 2 ;;1.41;BSDX;;Sep 29, 2010 3 ; 4 ; 5 NOSHOWD(BSDXY,BSDXAPTID,BSDXNS) ;EP 6 ;Entry point for debugging 7 ; 8 ;D DEBUG^%Serenji("NOSHOW^BSDX31(.BSDXY,BSDXAPTID,BSDXNS)") 9 Q 10 ; 11 NOSHOW(BSDXY,BSDXAPTID,BSDXNS) ;EP 12 ;Called by BSDX NOSHOW 13 ;Sets appointment noshow flag in BSDX APPOINTMENT file 14 ;BSDXAPTID is entry number in BSDX APPOINTMENT file 15 ;BSDXNS = 1: NOSHOW, 0: CANCEL NOSHO 16 ;Calls CANCEL^BSDAPI to set noshow data in ^DPT 17 ;Returns error code in recordset field ERRORID 18 ; 19 N BSDXNOD,BSDXPATID,BSDXSTART,BSDXID,BSDXI,BSDXZ,BSDXERR,BSDXMSG,BSDXFDA,BSDXIENS 20 N BSDXNOEV 21 S BSDXNOEV=1 ;Don't execute protocol 22 ; 23 D ^XBKVAR S X="ETRAP^BSDX31",@^%ZOSF("TRAP") 24 S BSDXI=0 25 K ^BSDXTMP($J) 26 S BSDXY="^BSDXTMP("_$J_")" 27 S ^BSDXTMP($J,BSDXI)="I00020ERRORID^T00030ERRORTEXT"_$C(30) 28 S BSDXI=BSDXI+1 29 TSTART 30 I '+BSDXAPTID D ERR(0,"BSDX31: Invalid Appointment ID") Q 31 I '$D(^BSDXAPPT(BSDXAPTID,0)) D ERR(0,"BSDX31: Invalid Appointment ID") Q 32 S BSDXNS=+BSDXNS 33 I BSDXNS'=1&(BSDXNS'=0) D ERR(0,"BSDX31: Invalid No Show value") Q 34 ; 35 ;Edit BSDX APPOINTMENT entry NOSHOW field 36 S BSDXNOD=^BSDXAPPT(BSDXAPTID,0) 37 I BSDXNOD="" D ERR(0,"BSDX31: Invalid Appointment ID") Q 38 S BSDXPATID=$P(BSDXNOD,U,5) 39 S BSDXSTART=$P(BSDXNOD,U) 40 ; 41 D BSDXNOS(BSDXAPTID,BSDXNS) 42 I $D(BSDXMSG("DIERR")) S BSDXMSG=$G(BSDXMSG("DIERR",1,"TEXT",1)) D ERR(0,"BSDX31: "_BSDXMSG) Q 43 ; 44 S BSDXSC1=$P(BSDXNOD,U,7) ;RESOURCEID 45 I BSDXSC1]"",$D(^BSDXRES(BSDXSC1,0)) D I $G(BSDXZ)]"" S BSDXERR="BSDX31: APNOSHO Returned: "_BSDXZ D ERR(0,BSDXERR) Q 46 . S BSDXNOD=^BSDXRES(BSDXSC1,0) 47 . S BSDXSC1=$P(BSDXNOD,U,4) ;HOSPITAL LOCATION 48 . I BSDXSC1]"",$D(^SC(BSDXSC1,0)) D APNOSHO(.BSDXZ,BSDXSC1,BSDXPATID,BSDXSTART,BSDXNS) 49 ; 50 TCOMMIT 51 S BSDXI=BSDXI+1 52 S ^BSDXTMP($J,BSDXI)="1^"_$C(30) 53 S BSDXI=BSDXI+1 54 S ^BSDXTMP($J,BSDXI)=$C(31) 55 Q 56 ; 57 APNOSHO(BSDXZ,BSDXSC1,BSDXDFN,BSDXSD,BSDXNS) ; 58 ; update file 2 info 59 ;Set noshow for patient BSDXDFN in clinic BSDXSC1 60 ;at time BSDXSD 61 N BSDXC,%H,BSDXCDT,BSDXIEN 62 N BSDXIENS,BSDXFDA,BSDXMSG 63 S %H=$H D YMD^%DTC 64 S BSDXCDT=X+% 65 ; 66 S BSDXIENS=BSDXSD_","_BSDXDFN_"," 67 I +BSDXNS D 68 . S BSDXFDA(2.98,BSDXIENS,3)="N" 69 . S BSDXFDA(2.98,BSDXIENS,14)=DUZ 70 . S BSDXFDA(2.98,BSDXIENS,15)=BSDXCDT 71 E D 72 . S BSDXFDA(2.98,BSDXIENS,3)="" 73 . S BSDXFDA(2.98,BSDXIENS,14)="" 74 . S BSDXFDA(2.98,BSDXIENS,15)="" 75 K BSDXIEN 76 D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG") 77 S BSDXZ=$G(BSDXMSG("DIERR",1,"TEXT",1)) 78 Q 79 ; 80 BSDXNOS(BSDXAPTID,BSDXNS) ; 81 ; 82 N BSDXFDA,BSDXIENS 83 S BSDXIENS=BSDXAPTID_"," 84 S BSDXFDA(9002018.4,BSDXIENS,.1)=BSDXNS ;NOSHOW 85 D FILE^DIE("","BSDXFDA","BSDXMSG") 86 ; 87 Q 88 ; 89 NOSEVT(BSDXPAT,BSDXSTART,BSDXSC) ;EP Called by BSDX NOSHOW APPOINTMENT event 90 ;when appointments NOSHOW via PIMS interface. 91 ;Propagates NOSHOW to BSDXAPPT and raises refresh event to running GUI clients 92 ; 93 Q:+$G(BSDXNOEV) 94 Q:'+$G(BSDXSC) 95 Q:$G(SDATA("AFTER","STATUS"))["AUTO RE-BOOK" 96 N BSDXSTAT,BSDXFOUND,BSDXRES 97 S BSDXSTAT=1 98 S:$G(SDATA("BEFORE","STATUS"))["NO-SHOW" BSDXSTAT=0 99 S BSDXFOUND=0 100 I $D(^BSDXRES("ALOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ALOC",BSDXSC,0)) S BSDXFOUND=$$NOSEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT) 101 I BSDXFOUND D NOSEVT3(BSDXRES) Q 102 I $D(^BXDXRES("ASSOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ASSOC",BSDXSC,0)) S BSDXFOUND=$$NOSEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT) 103 I BSDXFOUND D NOSEVT3(BSDXRES) 104 Q 105 ; 106 NOSEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT) ; 107 ;Get appointment id in BSDXAPT 108 ;If found, call BSDXNOS(BSDXAPPT) and return 1 109 ;else return 0 110 N BSDXFOUND,BSDXAPPT 111 S BSDXFOUND=0 112 Q:'+$G(BSDXRES) BSDXFOUND 113 Q:'$D(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART)) BSDXFOUND 114 S BSDXAPPT=0 F S BSDXAPPT=$O(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART,BSDXAPPT)) Q:'+BSDXAPPT D Q:BSDXFOUND 115 . S BSDXNOD=$G(^BSDXAPPT(BSDXAPPT,0)) Q:BSDXNOD="" 116 . I $P(BSDXNOD,U,5)=BSDXPAT,$P(BSDXNOD,U,12)="" S BSDXFOUND=1 Q 117 I BSDXFOUND,+$G(BSDXAPPT) D BSDXNOS(BSDXAPPT,BSDXSTAT) 118 Q BSDXFOUND 119 ; 120 NOSEVT3(BSDXRES) ; 121 ;Call RaiseEvent to notify GUI clients 122 ; 123 N BSDXRESN 124 S BSDXRESN=$G(^BSDXRES(BSDXRES,0)) 125 Q:BSDXRESN="" 126 S BSDXRESN=$P(BSDXRESN,"^") 127 D EVENT^BMXMEVN("BSDX SCHEDULE",BSDXRESN) 128 Q 129 ; 130 ; 131 ERR(BSDXERID,ERRTXT) ;Error processing 132 S:'+$G(BSDXI) BSDXI=999999 133 S BSDXI=BSDXI+1 134 TROLLBACK 135 S ^BSDXTMP($J,BSDXI)=BSDXERID_"^"_ERRTXT_$C(30) 136 S BSDXI=BSDXI+1 137 S ^BSDXTMP($J,BSDXI)=$C(31) 138 Q 139 ; 140 ETRAP ;EP Error trap entry 141 D ^%ZTER 142 I '$D(BSDXI) N BSDXI S BSDXI=999999 143 S BSDXI=BSDXI+1 144 D ERR(0,"BSDX31 Error: "_$G(%ZTERROR)) 145 Q 146 ; 147 IMHERE(BSDXRES) ;EP 148 ;Entry point for BSDX IM HERE remote procedure 149 S BSDXRES=1 150 Q 151 ; 1 BSDX31 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 12/6/10 8:25am 2 ;;1.42;BSDX;;Sep 29, 2010 3 ; Change Log: 4 ; v1.42 Oct 23 2010 WV/SMH 5 ; - Change transaction to restartable. Thanks to Zach Gonzalez 6 ; --> and Rick Marshall for their help. 7 ; v1.42 Dec 6 2010: Extensive refactoring 8 ; 9 ; Error Reference: 10 ; -1: zero or null Appt ID 11 ; -2: Invalid APPT ID (doesn't exist in ^BSDXAPPT) 12 ; -3: No-show flag is invalid 13 ; -100: M Error 14 ; 15 ; 16 NOSHOWD(BSDXY,BSDXAPTID,BSDXNS) ;EP 17 ;Entry point for debugging 18 ; 19 D DEBUG^%Serenji("NOSHOW^BSDX31(.BSDXY,BSDXAPTID,BSDXNS)") 20 Q 21 ; 22 UT ; Unit Tests 23 ; Test 1: Sanity Check 24 N ZZZ ; Garbage return variable 25 N DATE S DATE=$$NOW^XLFDT() 26 S DATE=$E(DATE,1,12) ; Just get minutes b/c of HL file input transform 27 D APPADD^BSDX07(.ZZZ,DATE,DATE+.0001,3,"Dr Office",30,"Old Note",1) 28 N APPID S APPID=+$P(^BSDXTMP($J,1),U) 29 D NOSHOW(.ZZZ,APPID,1) 30 I $P(^BSDXAPPT(APPID,0),U,10)'=1 W "ERROR T1",! B 31 I $P(^DPT(3,"S",DATE,0),U,2)'="N" W "ERROR T1",! B 32 ; Test 2: Undo noshow 33 D NOSHOW(.ZZZ,APPID,0) 34 I $P(^BSDXAPPT(APPID,0),U,10)'="0" W "ERROR T2",! B 35 I $P(^DPT(3,"S",DATE,0),U,2)'="" W "ERROR T2",! B 36 ; Test 3: -1 37 D NOSHOW(.ZZZ,"",0) 38 I $P(^BSDXTMP($J,1),U)'=-1 W "ERROR T3",! B 39 ; Test 4: -2 40 D NOSHOW(.ZZZ,2938748233,0) 41 I $P(^BSDXTMP($J,1),U)'=-2 W "ERROR T4",! B 42 QUIT 43 NOSHOW(BSDXY,BSDXAPTID,BSDXNS) ;EP - No show a patient 44 ; Called by RPC: BSDX NOSHOW 45 ; Sets appointment noshow flag in BSDX APPOINTMENT file and "S" node in File 2 46 ; 47 ; Parameters: 48 ; BSDXY: Global Return 49 ; BSDXAPTID is entry number in BSDX APPOINTMENT file 50 ; BSDXNS = 1: NOSHOW, 0: CANCEL NOSHO 51 ; 52 ; Returns ADO.net record set with fields 53 ; - ERRORID; ERRORTEXT 54 ; ERRORID of 1 is okay 55 ; Anything else is an error. 56 ; 57 ; Return Array; set and clear 58 S BSDXY=$NA(^BSDXTMP($J)) 59 K ^BSDXTMP($J) 60 ; $ET 61 N $ET S $ET="G ETRAP^BSDX31" 62 ; Basline vars 63 D ^XBKVAR ; Set up baseline variables (DUZ, DUZ(2)) if they don't exist 64 ; Counter 65 N BSDXI S BSDXI=0 66 ; Header Node 67 S ^BSDXTMP($J,BSDXI)="I00020ERRORID^T00030ERRORTEXT"_$C(30) 68 ; Begin transaction 69 TSTART (BSDXI,BSDXY,BSDXAPTID,BSDXNS):T="BSDX NOSHOW CANCEL^BSDX29" 70 ; Turn off SDAM APPT PROTOCOL BSDX Entries 71 N BSDXNOEV S BSDXNOEV=1 ;Don't execute protocol 72 ; Appointment ID check 73 I '+BSDXAPTID D ERR(-1,"BSDX31: Invalid Appointment ID") Q 74 I '$D(^BSDXAPPT(BSDXAPTID,0)) D ERR(-2,"BSDX31: Invalid Appointment ID") Q 75 ; Noshow value check - Must be 1 or 0 76 S BSDXNS=+BSDXNS 77 I BSDXNS'=1&(BSDXNS'=0) D ERR(-3,"BSDX31: Invalid No Show value") Q 78 ; Get Some data 79 N BSDXNOD S BSDXNOD=^BSDXAPPT(BSDXAPTID,0) ; Node 80 N BSDXPATID S BSDXPATID=$P(BSDXNOD,U,5) ; DFN 81 N BSDXSTART S BSDXSTART=$P(BSDXNOD,U) ; Start Date/Time 82 ; Edit BSDX APPOINTMENT entry 83 N BSDXMSG ; 84 D BSDXNOS(BSDXAPTID,BSDXNS,.BSDXMSG) ;Edit BSDX APPOINTMENT entry NOSHOW field 85 I $D(BSDXMSG("DIERR")) S BSDXMSG=$G(BSDXMSG("DIERR",1,"TEXT",1)) D ERR(-4,"BSDX31: "_BSDXMSG) Q 86 ; Edit File 2 "S" node entry 87 N BSDXZ,BSDXERR ; Error variables to control looping 88 S BSDXSC1=$P(BSDXNOD,U,7) ;RESOURCEID 89 ; If Resource ID exists, and HL exists (means that Resource is linked), No show in File 2 90 I BSDXSC1]"",$D(^BSDXRES(BSDXSC1,0)) D I $G(BSDXZ)]"" S BSDXERR="BSDX31: APNOSHO Returned: "_BSDXZ D ERR(-5,BSDXERR) Q 91 . S BSDXNOD=^BSDXRES(BSDXSC1,0) 92 . S BSDXSC1=$P(BSDXNOD,U,4) ;HOSPITAL LOCATION 93 . I BSDXSC1]"",$D(^SC(BSDXSC1,0)) D APNOSHO(.BSDXZ,BSDXSC1,BSDXPATID,BSDXSTART,BSDXNS) 94 ; 95 TCOMMIT 96 S BSDXI=BSDXI+1 97 S ^BSDXTMP($J,BSDXI)="1^"_$C(30) ; 1 means everything okay 98 S BSDXI=BSDXI+1 99 S ^BSDXTMP($J,BSDXI)=$C(31) 100 QUIT 101 ; 102 APNOSHO(BSDXZ,BSDXSC1,BSDXDFN,BSDXSD,BSDXNS) ; 103 ; update file 2 info 104 ;Set noshow for patient BSDXDFN in clinic BSDXSC1 105 ;at time BSDXSD 106 N BSDXC,%H,BSDXCDT,BSDXIEN 107 N BSDXIENS,BSDXFDA,BSDXMSG 108 S %H=$H D YMD^%DTC 109 S BSDXCDT=X+% 110 ; 111 S BSDXIENS=BSDXSD_","_BSDXDFN_"," 112 I +BSDXNS D 113 . S BSDXFDA(2.98,BSDXIENS,3)="N" 114 . S BSDXFDA(2.98,BSDXIENS,14)=DUZ 115 . S BSDXFDA(2.98,BSDXIENS,15)=BSDXCDT 116 E D 117 . S BSDXFDA(2.98,BSDXIENS,3)="" 118 . S BSDXFDA(2.98,BSDXIENS,14)="" 119 . S BSDXFDA(2.98,BSDXIENS,15)="" 120 K BSDXIEN 121 D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG") 122 S BSDXZ=$G(BSDXMSG("DIERR",1,"TEXT",1)) 123 Q 124 ; 125 BSDXNOS(BSDXAPTID,BSDXNS,BSDXMSG) ; 126 ; 127 N BSDXFDA,BSDXIENS 128 S BSDXIENS=BSDXAPTID_"," 129 S BSDXFDA(9002018.4,BSDXIENS,.1)=BSDXNS ;NOSHOW 130 D FILE^DIE("","BSDXFDA","BSDXMSG") 131 QUIT 132 ; 133 NOSEVT(BSDXPAT,BSDXSTART,BSDXSC) ;EP Called by BSDX NOSHOW APPOINTMENT event 134 ;when appointments NOSHOW via PIMS interface. 135 ;Propagates NOSHOW to BSDXAPPT and raises refresh event to running GUI clients 136 ; 137 Q:+$G(BSDXNOEV) 138 Q:'+$G(BSDXSC) 139 Q:$G(SDATA("AFTER","STATUS"))["AUTO RE-BOOK" 140 N BSDXSTAT,BSDXFOUND,BSDXRES 141 S BSDXSTAT=1 142 S:$G(SDATA("BEFORE","STATUS"))["NO-SHOW" BSDXSTAT=0 143 S BSDXFOUND=0 144 I $D(^BSDXRES("ALOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ALOC",BSDXSC,0)) S BSDXFOUND=$$NOSEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT) 145 I BSDXFOUND D NOSEVT3(BSDXRES) Q 146 I $D(^BXDXRES("ASSOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ASSOC",BSDXSC,0)) S BSDXFOUND=$$NOSEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT) 147 I BSDXFOUND D NOSEVT3(BSDXRES) 148 Q 149 ; 150 NOSEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT) ; 151 ;Get appointment id in BSDXAPT 152 ;If found, call BSDXNOS(BSDXAPPT) and return 1 153 ;else return 0 154 N BSDXFOUND,BSDXAPPT 155 S BSDXFOUND=0 156 Q:'+$G(BSDXRES) BSDXFOUND 157 Q:'$D(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART)) BSDXFOUND 158 S BSDXAPPT=0 F S BSDXAPPT=$O(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART,BSDXAPPT)) Q:'+BSDXAPPT D Q:BSDXFOUND 159 . S BSDXNOD=$G(^BSDXAPPT(BSDXAPPT,0)) Q:BSDXNOD="" 160 . I $P(BSDXNOD,U,5)=BSDXPAT,$P(BSDXNOD,U,12)="" S BSDXFOUND=1 Q 161 I BSDXFOUND,+$G(BSDXAPPT) D BSDXNOS(BSDXAPPT,BSDXSTAT) 162 Q BSDXFOUND 163 ; 164 NOSEVT3(BSDXRES) ; 165 ;Call RaiseEvent to notify GUI clients 166 ; 167 N BSDXRESN 168 S BSDXRESN=$G(^BSDXRES(BSDXRES,0)) 169 Q:BSDXRESN="" 170 S BSDXRESN=$P(BSDXRESN,"^") 171 D EVENT^BMXMEVN("BSDX SCHEDULE",BSDXRESN) 172 Q 173 ; 174 ; 175 ERR(BSDXERID,ERRTXT) ;Error processing 176 S BSDXI=BSDXI+1 177 TROLLBACK 178 S ^BSDXTMP($J,BSDXI)=BSDXERID_"^"_ERRTXT_$C(30) 179 S BSDXI=BSDXI+1 180 S ^BSDXTMP($J,BSDXI)=$C(31) 181 Q 182 ; 183 ETRAP ;EP Error trap entry 184 D ^%ZTER 185 I '$D(BSDXI) N BSDXI S BSDXI=999999 186 S BSDXI=BSDXI+1 187 D ERR(0,"BSDX31 Error: "_$G(%ZTERROR)) 188 Q 189 ; 190 IMHERE(BSDXRES) ;EP 191 ;Entry point for BSDX IM HERE remote procedure 192 S BSDXRES=1 193 Q 194 ;
Note:
See TracChangeset
for help on using the changeset viewer.
