216 lines
9.6 KiB
Mathematica
216 lines
9.6 KiB
Mathematica
PSBRPC ;BIRMINGHAM/EFC-BCMA RPC BROKER CALLS ;Mar 2004
|
|
;;3.0;BAR CODE MED ADMIN;**6,3,4,13,32**;Mar 2004;Build 32
|
|
;Per VHA Directive 2004-038 (or future revisions regarding same), this routine should not be modified.
|
|
;
|
|
; Reference/IA
|
|
; EN1^GMRADPT/10099
|
|
; EN6^GMRVUTL/1120
|
|
; DEM^VADPT/10061
|
|
; IN5^VADPT/10061
|
|
; File 200/10060
|
|
; File 211.4/1409
|
|
; CHECKAV^XUSRB/2882
|
|
; GUIMTD^DPTLK6/3023
|
|
; ^ORD(101.24/3429
|
|
; File 2/10035
|
|
; File 4/10090
|
|
; EN1^GMRVUT0/1446
|
|
; HASH^XUSHSHP/10045
|
|
; $$DECRYP^XUSRB1/2241
|
|
; ^DIC(42/1377
|
|
; ^DIC(42/2440
|
|
; $$GETACT^DGPFAPI/3860
|
|
; $$GETICN^MPIF001/2701
|
|
; $$GETDFN^MPIF001/2701
|
|
; $$PROD^XUPROD/4440
|
|
; $$GET^XPAR/2263
|
|
; EN^XPAR/2263
|
|
; $$BASE^XLFUTL/2622
|
|
FMDATE(RESULTS,X) ;
|
|
; RPC: PSB FMDATE Descr: Returns FM D/T frm Clnt DateToStr()
|
|
I $P(X,"@",2)="0000" S $P(X,"@",2)="0001"
|
|
;if no time for dates, append the current time
|
|
I $P(X,"@",2)="",X'?1"N" D S $P(X,"@",2)=$P(Y,"@",2)
|
|
. N X
|
|
. S X="N",%DT="T" D ^%DT,DD^%DT
|
|
S %DT="T" D ^%DT
|
|
I +Y<1 S RESULTS(0)="-1^Invalid Date/Time" Q
|
|
S RESULTS(0)=Y D D^DIQ
|
|
S RESULTS(0)=RESULTS(0)_U_Y
|
|
Q
|
|
USRLOAD(RESULTS,DUMMY) ;
|
|
; RPC: PSB USERLOAD
|
|
S RESULTS(0)=DUZ ;UsrIEN
|
|
S RESULTS(1)=$$GET1^DIQ(200,DUZ_",",.01) ; Usr Nm
|
|
S RESULTS(2)=$S($D(^XUSEC("PSB STUDENT",DUZ)):1,1:0) ; Studnt?
|
|
S RESULTS(3)=$S($D(^XUSEC("PSB MANAGER",DUZ)):1,1:0) ; Mgr?
|
|
S RESULTS(4)=$S($D(^XUSEC("PSB CPRS MED BUTTON",DUZ)):1,1:0)
|
|
S RESULTS(5)=$$GET^XPAR("USR","PSB WINDOW")
|
|
S X=$S(+$$GET^XPAR("ALL","PSB VDL INCL CONT"):"T",1:"F")
|
|
S X=X_"/"_$S(+$$GET^XPAR("ALL","PSB VDL INCL PRN"):"T",1:"F")
|
|
S X=X_"/"_$S(+$$GET^XPAR("ALL","PSB VDL INCL ONE-TIME"):"T",1:"F")
|
|
S X=X_"/"_$S(+$$GET^XPAR("ALL","PSB VDL INCL ON-CALL"):"T",1:"F")
|
|
S X=X_"/"_+$$GET^XPAR("ALL","PSB VDL SORT COLUMN")
|
|
S X=X_"/"_+$$GET^XPAR("ALL","PSB VDL PB SORT COLUMN")
|
|
S X=X_"/"_+$$GET^XPAR("ALL","PSB VDL IV SORT COLUMN")
|
|
S RESULTS(6)=X ;VDL Setp
|
|
S RESULTS(7)=+$G(DUZ(2))
|
|
I RESULTS(7) S RESULTS(8)=$$GET1^DIQ(4,RESULTS(7)_",",.01)
|
|
E S RESULTS(8)="Undefined Division"
|
|
S RESULTS(7)=RESULTS(7)_U_$P($$SITE^VASITE,U,3)
|
|
I $T(PROD^XUPROD)]"" S RESULTS(7)=RESULTS(7)_U_$$PROD^XUPROD(1)
|
|
S RESULTS(9)=+$$GET^XPAR("DIV","PSB ADMIN ESIG")
|
|
S RESULTS(10)=+$$GET^XPAR("DIV","PSB ONLINE")
|
|
S RESULTS(11)=$G(DTIME,300)
|
|
S RESULTS(12)=$$GET^XPAR("USR","PSB UNIT DOSE COLUMN WIDTHS")
|
|
S RESULTS(13)=$J_"^"_$$BASE^XLFUTL($J,10,16)
|
|
S RESULTS(14)=$$GET^XPAR("USR","PSB IVPB COLUMN WIDTHS")
|
|
S RESULTS(15)=$$GET^XPAR("USR","PSB IV COLUMN WIDTHS")
|
|
S RESULTS(16)=$$GET^XPAR("USR","PSB PRINTER USER DEFAULT")
|
|
S RESULTS(17)=$$GET^XPAR("USR","PSB GUI DEFAULT PRINTER")
|
|
S RESULTS(18)=$S($D(^XUSEC("PSB READ ONLY",DUZ)):1,1:0)
|
|
S RESULTS(19)=$$GET^XPAR("USR","PSB COVERSHEET VIEWS COL SORT")
|
|
S RESULTS(20)=$$GET^XPAR("USR","PSB COVERSHEET V1 COL WIDTHS")
|
|
S RESULTS(21)=$$GET^XPAR("USR","PSB COVERSHEET V2 COL WIDTHS")
|
|
S RESULTS(22)=$$GET^XPAR("USR","PSB COVERSHEET V3 COL WIDTHS")
|
|
S RESULTS(23)=$$GET^XPAR("USR","PSB COVERSHEET V4 COL WIDTHS")
|
|
Q
|
|
USRSAVE(RESULTS,PSBWIN,PSBVDL,PSBUDCW,PSBPBCW,PSBIVCW,PSBDEV,PSBCSRT,PSBCV1,PSBCV2,PSBCV3,PSBCV4) ;
|
|
; RPC: PSB USERSAVE ; Saves user settings.
|
|
S RESULTS(0)="-1^FAILED - Parameters Save"
|
|
S PSBWIN=$G(PSBWIN),PSBVDL=$G(PSBVDL),PSBUDCW=$G(PSBUDCW)
|
|
S PSBPBCW=$G(PSBPBCW),PSBIVCW=$G(PSBIVCW),PSBDEV=$G(PSBDEV)
|
|
S PSBCSRT=$G(PSBCSRT),PSBCV1=$G(PSBCV1),PSBCV2=$G(PSBCV2),PSBCV3=$G(PSBCV3),PSBCV4=$G(PSBCV4)
|
|
D EN^XPAR("USR","PSB WINDOW",1,PSBWIN)
|
|
D EN^XPAR("USR","PSB VDL INCL CONT",1,$P(PSBVDL,"/",1)["T")
|
|
D EN^XPAR("USR","PSB VDL INCL PRN",1,$P(PSBVDL,"/",2)["T")
|
|
D EN^XPAR("USR","PSB VDL INCL ONE-TIME",1,$P(PSBVDL,"/",3)["T")
|
|
D EN^XPAR("USR","PSB VDL INCL ON-CALL",1,$P(PSBVDL,"/",4)["T")
|
|
D EN^XPAR("USR","PSB VDL SORT COLUMN",1,+$P(PSBVDL,"/",5))
|
|
D EN^XPAR("USR","PSB VDL PB SORT COLUMN",1,+$P(PSBVDL,"/",6))
|
|
D EN^XPAR("USR","PSB VDL IV SORT COLUMN",1,+$P(PSBVDL,"/",7))
|
|
D EN^XPAR("USR","PSB UNIT DOSE COLUMN WIDTHS",1,PSBUDCW)
|
|
D EN^XPAR("USR","PSB IVPB COLUMN WIDTHS",1,PSBPBCW)
|
|
D EN^XPAR("USR","PSB IV COLUMN WIDTHS",1,PSBIVCW)
|
|
D EN^XPAR("USR","PSB GUI DEFAULT PRINTER",1,PSBDEV)
|
|
D EN^XPAR("USR","PSB COVERSHEET VIEWS COL SORT",1,PSBCSRT)
|
|
D EN^XPAR("USR","PSB COVERSHEET V1 COL WIDTHS",1,PSBCV1)
|
|
D EN^XPAR("USR","PSB COVERSHEET V2 COL WIDTHS",1,PSBCV2)
|
|
D EN^XPAR("USR","PSB COVERSHEET V3 COL WIDTHS",1,PSBCV3)
|
|
D EN^XPAR("USR","PSB COVERSHEET V4 COL WIDTHS",1,PSBCV4)
|
|
S RESULTS(0)="1^Parameters Saved"
|
|
Q
|
|
INST(RESULTS,PSBACC,PSBVER) ;
|
|
; RPC: PSB INSTRUCTOR
|
|
; Descr:
|
|
; Used by frmInstructor to validate an instructor(s) at
|
|
; the client via encrypted A/V Code.
|
|
S PSBACC=$$DECRYP^XUSRB1(PSBACC)
|
|
S PSBVER=$$DECRYP^XUSRB1(PSBVER)
|
|
S PSBINST=$$CHECKAV^XUSRB(PSBACC_";"_PSBVER)
|
|
I PSBINST<1 S RESULTS(0)="-1^Invalid Instructor Sign-On" K PSBINST Q
|
|
I '$D(^XUSEC("PSB INSTRUCTOR",PSBINST)) S RESULTS(0)="-1^Instructor doesn't have authority" K PSBINST Q
|
|
S PSBINST(0)=$$GET1^DIQ(200,PSBINST_",",.01)
|
|
S RESULTS(0)=PSBINST_U_PSBINST(0)
|
|
Q
|
|
ESIG(RESULTS,PSBESIG) ;
|
|
; RPC: PSB VALIDATE ESIG ; Validate the data in PSBESIG against user (DUZ)
|
|
S PSBDSIG=$P($G(PSBESIG),U,2) I PSBDSIG'="" S PSBDSIG=$$DECRYP^XUSRB1(PSBDSIG),PSBESIG=PSBDSIG
|
|
I $G(PSBESIG)="" S RESULTS(0)="-1^Must Supply ESig" Q
|
|
S X=PSBESIG D HASH^XUSHSHP
|
|
I X'=$$GET1^DIQ(200,DUZ_",",20.4,"I") S RESULTS(0)="-1^Invalid ESig"
|
|
E S RESULTS(0)="1^ESig Verified"
|
|
Q
|
|
SCANPT(RESULTS,PSBDATA) ; Lookup Pt by Full SSN
|
|
; RPC: PSB SCANPT
|
|
; File #2 lookup either by full SSN
|
|
; returns -1 error / patient data
|
|
; Check for Interleave 2 of 5 Check Digit on SSN and remove
|
|
N DFN
|
|
I "SS"[$P($G(PSBDATA),"^",3) D Q:RESULTS(1)<0
|
|
.S:$P(PSBDATA,"^")?1"0"9N.U PSBDATA=$E(PSBDATA,2,99) N PSBCNT
|
|
.I $P(PSBDATA,U)'?9N.1U S RESULTS(0)=1,RESULTS(1)="-1^Invalid Patient Lookup" Q
|
|
.S X=$$FIND1^DIC(2,"","",$P(PSBDATA,U),"SSN")
|
|
.I X<1 S RESULTS(0)=1,RESULTS(1)="-1^Invalid Patient Lookup" Q
|
|
.S (DFN,RESULTS(1),PSBDFN)=X
|
|
.S PSBICN=$$GETICN^MPIF001(PSBDFN) I +PSBICN=-1 S PSBICN=""
|
|
I $G(DFN)']"" D Q:+PSBDFN'>0
|
|
.; CCOW !
|
|
.I "DF"[$P($G(PSBDATA),"^",3) S PSBDFN=$P($G(PSBDATA),"^"),PSBICN=$$GETICN^MPIF001(PSBDFN) I +PSBICN=-1 S PSBICN="",RESULTS(0)=1,RESULTS(1)="-1^Cannot find ICN via DFN"
|
|
.I "IC"[$P($G(PSBDATA),"^",3) S PSBICN=$P($G(PSBDATA),"^"),PSBDFN=$$GETDFN^MPIF001(PSBICN) I +PSBDFN=-1 S PSBDFN="",RESULTS(0)=1,RESULTS(1)="-1^Cannot find DFN via ICN" Q
|
|
.S (DFN,RESULTS(1))=PSBDFN
|
|
K VADM,VAIN
|
|
D DEM^VADPT,IN5^VADPT
|
|
I ('$P(PSBDATA,U,2))&('VAIP(13)&'VADM(6)) S RESULTS(0)=1,RESULTS(1)="-1^Patient has been DISCHARGED" I ($P($G(PSBDATA),U,3)'["IC")&($P($G(PSBDATA),U,3)'["DF") K VAIP,VADM Q
|
|
I ('$P(PSBDATA,U,2))&(VADM(6)'="") S RESULTS(0)=1,RESULTS(1)="-1^"_"This patient died "_$TR($P(VADM(6),U,2),"@"," ") I ($P($G(PSBDATA),U,3)'["IC")&($P($G(PSBDATA),U,3)'["DF") K VAIP,VADM Q
|
|
S RESULTS(1)=PSBDFN
|
|
F X=1,2,3,4,5 S RESULTS(X+1)=$G(VADM(X))
|
|
F X=3,4,5,6,7,8,9,10,11 S RESULTS(X+4)=$G(VAIP(X))
|
|
S $P(RESULTS(9),U,3)=$$GET1^DIQ(42,$P(RESULTS(9),U)_",",44,"I")_"^"_$$GET1^DIQ(42,$P(RESULTS(9),U)_",",44)
|
|
S GMRVSTR="HT" D EN6^GMRVUTL
|
|
S X=+$P(X,U,8) S:X X=X*2.54\1 S PSBHDR("HEIGHT")=$S(X:X_"cm",1:"*")
|
|
S RESULTS(16)=PSBHDR("HEIGHT")
|
|
S GMRVSTR="WT" D EN6^GMRVUTL
|
|
S X=+$P(X,U,8) S X=$J(X/2.2,0,2) S PSBHDR("WEIGHT")=$S(X:X_"kg",1:"*")
|
|
S RESULTS(17)=PSBHDR("WEIGHT")
|
|
S GMRA="0^0^111" D EN1^GMRADPT
|
|
I $O(GMRAL(0)) S RESULTS(18)=1
|
|
E S RESULTS(18)=0
|
|
; Means Tst
|
|
D GUIMTD^DPTLK6(.PSBDATA,PSBDFN)
|
|
S RESULTS(19)=+$G(PSBDATA(1))_U_$G(PSBDATA(2))_U_$G(PSBDATA(3))
|
|
S PSBICN=$$GETICN^MPIF001(PSBDFN) I +PSBICN=-1 S PSBICN=""
|
|
S RESULTS(20)=PSBICN
|
|
S RESULTS(21)="",RESULTS(0)=21
|
|
S:VADM(6)'="" RESULTS(21)="This patient died "_$TR($P(VADM(6),U,2),"@"," ")
|
|
S:('VAIP(13))&('VADM(6)) RESULTS(21)="Patient has been DISCHARGED"
|
|
S (RESULTS(0),PSBCNT)=22
|
|
S RESULTS(PSBCNT)=""
|
|
F PSBINDX=1:1:($$GETACT^DGPFAPI(PSBDFN,.PSBPTFLG)) D
|
|
.Q:'$D(PSBPTFLG) Q:'$D(@(PSBPTFLG_"(PSBINDX,""FLAG"")")) S PSBPFLAG="PATFLG",$P(PSBPFLAG,U,2)=$P(@(PSBPTFLG_"(PSBINDX,""FLAG"")"),"^",2)
|
|
.S $P(PSBPFLAG,U,3)=PSBINDX,PSBCNT=21+PSBINDX,RESULTS(PSBCNT)=PSBPFLAG
|
|
S RESULTS(0)=PSBCNT
|
|
I $D(PSBPTFLG) K @PSBPTFLG
|
|
K VAIP,VADM
|
|
Q
|
|
MAX(RESULTS,PSBDAYS) ;
|
|
; RPC: PSB MAXDAYS ; Max days - MAH
|
|
S X=$O(^ORD(101.24,"B","ORRP BCMA MAH",""))
|
|
S RESULTS(0)=$$GET1^DIQ(101.24,X_",",.42)
|
|
Q
|
|
NWLIST(RESULTS,DUMMY) ; ward/nurs File #211.4
|
|
K ^TMP("PSB",$J)
|
|
S PSBIEN=0 F S PSBIEN=$O(^NURSF(211.4,PSBIEN)) Q:PSBIEN'?.N D
|
|
.S ^TMP("PSB",$J,$$GET1^DIQ(211.4,PSBIEN_",",.01)_" [NURS UNIT]")=PSBIEN
|
|
.S PSBX=0 F S PSBX=$O(^NURSF(211.4,PSBIEN,3,PSBX)) Q:PSBX="" D
|
|
..S PSBWIEN=$P(^NURSF(211.4,PSBIEN,3,PSBX,0),"^")
|
|
..I $$GET1^DIQ(42,PSBWIEN_",",.01)]"" S ^TMP("PSB",$J,$$GET1^DIQ(42,PSBWIEN_",",.01)_" [MAS WARD]")=PSBIEN
|
|
S RESULTS(0)=0
|
|
S X="" F S X=$O(^TMP("PSB",$J,X)) Q:X="" D
|
|
.S RESULTS(0)=RESULTS(0)+1
|
|
.S RESULTS(RESULTS(0))=^TMP("PSB",$J,X)_U_X_U_$S(($$GET1^DIQ(211.4,^TMP("PSB",$J,X)_",",1)="ACTIVE")&($$GET1^DIQ(211.4,^TMP("PSB",$J,X)_",",1.5)'="**INACTIVE**"):"1",1:"0")
|
|
K ^TMP("PSB",$J)
|
|
Q
|
|
VITALS(RESULTS,DFN) ;Vitals API
|
|
; RPC PSB VITALS
|
|
K RESULTS
|
|
N PSBSTRT,PSBSTOP,PSBNOW
|
|
S PSBDFN=DFN,GMRVSTR="T;P;R;BP;PN"
|
|
D NOW^%DTC S PSBNOW=%,PSBSTRT=$$FMADD^XLFDT(PSBNOW,"",-168),PSBSTOP=PSBNOW,GMRVSTR(0)=PSBSTRT_U_PSBSTOP_U_4_U
|
|
K ^UTILITY($J,"GMRVD")
|
|
D EN1^GMRVUT0
|
|
S PSBCNT=1
|
|
I '$D(^UTILITY($J,"GMRVD")) S RESULTS(0)=PSBCNT,RESULTS(PSBCNT)="No Vitals to report" Q
|
|
S PSBTYP=""
|
|
F S PSBTYP=$O(^UTILITY($J,"GMRVD",PSBTYP)) Q:PSBTYP="" D
|
|
.S PSBRDT=""
|
|
.F S PSBRDT=$O(^UTILITY($J,"GMRVD",PSBTYP,PSBRDT)) Q:PSBRDT="" D
|
|
..S PSBIEN=""
|
|
..F S PSBIEN=$O(^UTILITY($J,"GMRVD",PSBTYP,PSBRDT,PSBIEN)) Q:PSBIEN="" D
|
|
...S PSBDATA=($G(^UTILITY($J,"GMRVD",PSBTYP,PSBRDT,PSBIEN)))
|
|
...S RESULTS(PSBCNT)=PSBTYP_U_$P(PSBDATA,U,1,2)_U_$P(PSBDATA,U,8)
|
|
...S PSBCNT=PSBCNT+1
|
|
S RESULTS(0)=PSBCNT-1
|
|
K ^UTILITY($J,"GMRVD"),GMRBSTR,PSBDFN,PSBTYPE,PSBDATA,PSBCNT
|
|
Q
|