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