- BSDX36 ; IHS/OIT/HMW/MSC/SAT - WINDOWS SCHEDULING RPCS ;
- ;;3.0;IHS WINDOWS SCHEDULING;;DEC 09, 2010
- ;
- ;COLLECT WAITLIST FOR GIVEN RESOURCE - RPC
- CW(BSDXY,BSDXRES) ;COLLECT WAITLIST DATA
- ; .BSDXY = returned pointer to list of waitlist data
- ; BSDXRES = resource code - pointer to ^BSDXRES (BSDX RESOURCE)
- ; called by BSDX WAITLIST remote procedure
- N BSDXI,BSDXNOD,BSDXRESN,BSDXSC,BSDXTMP,BSDWL,BSDXWLD,BSDXWLN,CI,WL
- D ^XBKVAR S X="ERROR^BSDX36",@^%ZOSF("TRAP")
- S BSDXI=0
- K ^BSDXTMP($J)
- S BSDXY="^BSDXTMP("_$J_")"
- S ^BSDXTMP($J,0)="T00020ERRORID"_$C(30)
- ;check for valid resource
- I '+BSDXRES D ERR("BSDX36: Invalid Resource ID") Q
- I '$D(^BSDXRES(BSDXRES,0)) D ERR("BSDX36: Invalid Resource ID") Q
- S BSDXNOD=^BSDXRES(BSDXRES,0)
- S BSDXSC=$P(BSDXNOD,U,4)
- ;check that hospital location is defined for this resource
- I '+BSDXSC D ERR("BSDX36: Resource "_$P(BSDXNOD,U,1)_" does not have a Hospital Location defined") Q
- I '$D(^SC(BSDXSC,0)) D ERR("BSDX36: Resource "_$P(BSDXNOT,U,1)_" has an invalid Hospital Location defined") Q
- ;GET WL POINTER FROM ^BSDWL("B",SC,WL)
- S BSDWL=$O(^BSDWL("B",BSDXSC,""))
- S BSDXWLD=$G(^BSDWL(BSDWL,0))
- ;check if wait list is inactive
- I $P(BSDXWLD,U,2) D ERR("BSDX36: WaitList for "_$P(^SC(BSDXSC,0),U,1)_" is inactive") Q
- ; 1 2 3 4 5
- S BSDXTMP="I00020HOSPITAL_LOC_IEN^I00020WAIT_LIST_IEN^I00020PATIENT_IEN^T00030PATIENT_NAME^T00030HOME_PHONE^"
- ; 6 7 8 9 10 11
- S BSDXTMP=BSDXTMP_"T00020WORK_PHONE^T00030CHART^D00020DATE_ADDED^T00030REASON^T00020PRIORITY^I00020PROVIDER^"
- ; 12 13
- S BSDXTMP=BSDXTMP_"D00020RECALL_DATE^T00250COMMENT"_$C(30)
- S ^BSDXTMP($J,0)=BSDXTMP
- ;loop through waitlist
- ;RETURN LOOKS LIKE:
- ; BSDXTMP(<counter>,"C",<c counter>)=Comment text
- S WL=0
- F S WL=$O(^BSDWL(BSDWL,1,WL)) Q:(WL="")||('WL) D
- . S BSDXWLN=$G(^BSDWL(BSDWL,1,WL,0))
- . S DFN=$P(BSDXWLN,U,1)
- . S DPTN=$G(^DPT(DFN,.13))
- . S BSDXI=BSDXI+1
- . ; 1 2 3 4 5
- . S BSDXTMP=BSDXSC_U_WL_U_$P(BSDXWLN,U,1)_U_$P(^DPT($P(BSDXWLN,U,1),0),U,1)_U_$P(DPTN,U,1)_U
- . ; 6 7 8
- . S BSDXTMP=BSDXTMP_$P(DPTN,U,2)_U_$$HRCN^BDGF2(DFN,+$$FAC^BSDU(BSDXSC))_U_$$FMTE^XLFDT($P(BSDXWLN,U,3))_U
- . ; 9 10
- . S BSDXTMP=BSDXTMP_$P(^BSDWLR($P(BSDXWLN,U,9),0),U,1)_U_$S($P(BSDXWLN,U,2)=1:"HIGH",$P(BSDXWLN,U,2)=2:"MIDDLE",$P(BSDXWLN,U,2)=3:"LOW",1:"")_U
- . ; 11 12 13
- . S BSDXTMP=BSDXTMP_$P(^VA(200,$P(BSDXWLN,U,6),0),U,1)_U_$$FMTE^XLFDT($P(BSDXWLN,U,5))_U_$G(^BSDWL(BSDWL,1,WL,1,1,0))
- . S ^BSDXTMP($J,BSDXI)=BSDXTMP
- . S CI=""
- . F S CI=$O(^BSDWL(BSDWL,1,WL,1,CI)) Q:'+CI D
- . . S BSDWLN=$G(^BSDWL(BSDWL,1,WL,1,CI,0))
- . . S:$E(BSDWLN,$L(BSDWLN)-1,$L(BSDWLN))'=" " BSDWLN=BSDWLN_" "
- . . S BSDXI=BSDXI+1
- . . S ^BSDXTMP($J,BSDXI)=BSDWLN
- . S BSDXI=BSDXI+1
- . S ^BSDXTMP($J,BSDXI)=$C(30)
- S BSDXI=BSDXI+1
- S ^BSDXTMP($J,BSDXI)=$C(31)
- Q
- ;
- ERROR ;
- D ERR("RPMS Error")
- Q
- ;
- ERR(BSDXERR) ;Error processing
- I +BSDXERR S BSDXERR=ERRNO+134234112 ;vbObjectError
- S BSDXI=BSDXI+1
- S ^BSDXTMP($J,BSDXI)=BSDXERR_$C(30)
- S BSDXI=BSDXI+1
- S ^BSDXTMP($J,BSDXI)=$C(31)
- Q
- BSDX36 ; IHS/OIT/HMW/MSC/SAT - WINDOWS SCHEDULING RPCS ;
- +1 ;;3.0;IHS WINDOWS SCHEDULING;;DEC 09, 2010
- +2 ;
- +3 ;COLLECT WAITLIST FOR GIVEN RESOURCE - RPC
- CW(BSDXY,BSDXRES) ;COLLECT WAITLIST DATA
- +1 ; .BSDXY = returned pointer to list of waitlist data
- +2 ; BSDXRES = resource code - pointer to ^BSDXRES (BSDX RESOURCE)
- +3 ; called by BSDX WAITLIST remote procedure
- +4 NEW BSDXI,BSDXNOD,BSDXRESN,BSDXSC,BSDXTMP,BSDWL,BSDXWLD,BSDXWLN,CI,WL
- +5 DO ^XBKVAR
- SET X="ERROR^BSDX36"
- SET @^%ZOSF("TRAP")
- +6 SET BSDXI=0
- +7 KILL ^BSDXTMP($JOB)
- +8 SET BSDXY="^BSDXTMP("_$JOB_")"
- +9 SET ^BSDXTMP($JOB,0)="T00020ERRORID"_$CHAR(30)
- +10 ;check for valid resource
- +11 IF '+BSDXRES
- DO ERR("BSDX36: Invalid Resource ID")
- QUIT
- +12 IF '$DATA(^BSDXRES(BSDXRES,0))
- DO ERR("BSDX36: Invalid Resource ID")
- QUIT
- +13 SET BSDXNOD=^BSDXRES(BSDXRES,0)
- +14 SET BSDXSC=$PIECE(BSDXNOD,U,4)
- +15 ;check that hospital location is defined for this resource
- +16 IF '+BSDXSC
- DO ERR("BSDX36: Resource "_$PIECE(BSDXNOD,U,1)_" does not have a Hospital Location defined")
- QUIT
- +17 IF '$DATA(^SC(BSDXSC,0))
- DO ERR("BSDX36: Resource "_$PIECE(BSDXNOT,U,1)_" has an invalid Hospital Location defined")
- QUIT
- +18 ;GET WL POINTER FROM ^BSDWL("B",SC,WL)
- +19 SET BSDWL=$ORDER(^BSDWL("B",BSDXSC,""))
- +20 SET BSDXWLD=$GET(^BSDWL(BSDWL,0))
- +21 ;check if wait list is inactive
- +22 IF $PIECE(BSDXWLD,U,2)
- DO ERR("BSDX36: WaitList for "_$PIECE(^SC(BSDXSC,0),U,1)_" is inactive")
- QUIT
- +23 ; 1 2 3 4 5
- +24 SET BSDXTMP="I00020HOSPITAL_LOC_IEN^I00020WAIT_LIST_IEN^I00020PATIENT_IEN^T00030PATIENT_NAME^T00030HOME_PHONE^"
- +25 ; 6 7 8 9 10 11
- +26 SET BSDXTMP=BSDXTMP_"T00020WORK_PHONE^T00030CHART^D00020DATE_ADDED^T00030REASON^T00020PRIORITY^I00020PROVIDER^"
- +27 ; 12 13
- +28 SET BSDXTMP=BSDXTMP_"D00020RECALL_DATE^T00250COMMENT"_$CHAR(30)
- +29 SET ^BSDXTMP($JOB,0)=BSDXTMP
- +30 ;loop through waitlist
- +31 ;RETURN LOOKS LIKE:
- +32 ; BSDXTMP(<counter>,"C",<c counter>)=Comment text
- +33 SET WL=0
- +34 FOR
- SET WL=$ORDER(^BSDWL(BSDWL,1,WL))
- IF (WL="")||('WL)
- QUIT
- Begin DoDot:1
- +35 SET BSDXWLN=$GET(^BSDWL(BSDWL,1,WL,0))
- +36 SET DFN=$PIECE(BSDXWLN,U,1)
- +37 SET DPTN=$GET(^DPT(DFN,.13))
- +38 SET BSDXI=BSDXI+1
- +39 ; 1 2 3 4 5
- +40 SET BSDXTMP=BSDXSC_U_WL_U_$PIECE(BSDXWLN,U,1)_U_$PIECE(^DPT($PIECE(BSDXWLN,U,1),0),U,1)_U_$PIECE(DPTN,U,1)_U
- +41 ; 6 7 8
- +42 SET BSDXTMP=BSDXTMP_$PIECE(DPTN,U,2)_U_$$HRCN^BDGF2(DFN,+$$FAC^BSDU(BSDXSC))_U_$$FMTE^XLFDT($PIECE(BSDXWLN,U,3))_U
- +43 ; 9 10
- +44 SET BSDXTMP=BSDXTMP_$PIECE(^BSDWLR($PIECE(BSDXWLN,U,9),0),U,1)_U_$SELECT($PIECE(BSDXWLN,U,2)=1:"HIGH",$PIECE(BSDXWLN,U,2)=2:"MIDDLE",$PIECE(BSDXWLN,U,2)=3:"LOW",1:"")_U
- +45 ; 11 12 13
- +46 SET BSDXTMP=BSDXTMP_$PIECE(^VA(200,$PIECE(BSDXWLN,U,6),0),U,1)_U_$$FMTE^XLFDT($PIECE(BSDXWLN,U,5))_U_$GET(^BSDWL(BSDWL,1,WL,1,1,0))
- +47 SET ^BSDXTMP($JOB,BSDXI)=BSDXTMP
- +48 SET CI=""
- +49 FOR
- SET CI=$ORDER(^BSDWL(BSDWL,1,WL,1,CI))
- IF '+CI
- QUIT
- Begin DoDot:2
- +50 SET BSDWLN=$GET(^BSDWL(BSDWL,1,WL,1,CI,0))
- +51 IF $EXTRACT(BSDWLN,$LENGTH(BSDWLN)-1,$LENGTH(BSDWLN))'=" "
- SET BSDWLN=BSDWLN_" "
- +52 SET BSDXI=BSDXI+1
- +53 SET ^BSDXTMP($JOB,BSDXI)=BSDWLN
- End DoDot:2
- +54 SET BSDXI=BSDXI+1
- +55 SET ^BSDXTMP($JOB,BSDXI)=$CHAR(30)
- End DoDot:1
- +56 SET BSDXI=BSDXI+1
- +57 SET ^BSDXTMP($JOB,BSDXI)=$CHAR(31)
- +58 QUIT
- +59 ;
- ERROR ;
- +1 DO ERR("RPMS Error")
- +2 QUIT
- +3 ;
- ERR(BSDXERR) ;Error processing
- +1 ;vbObjectError
- IF +BSDXERR
- SET BSDXERR=ERRNO+134234112
- +2 SET BSDXI=BSDXI+1
- +3 SET ^BSDXTMP($JOB,BSDXI)=BSDXERR_$CHAR(30)
- +4 SET BSDXI=BSDXI+1
- +5 SET ^BSDXTMP($JOB,BSDXI)=$CHAR(31)
- +6 QUIT
