Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSBRPC

PSBRPC.m

Go to the documentation of this file.
  1. PSBRPC ;BIRMINGHAM/EFC - BCMA RPC BROKER CALLS ; 19 Jul 2013 12:34 PM
  1. ;;3.0;BAR CODE MED ADMIN;**6,3,4,13,32,28,42,58,66,70,76,86**;Mar 2004;Build 5
  1. ;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ; Reference/IA
  1. ; File 211.4/1409
  1. ; CHECKAV^XUSRB/2882
  1. ; GUIMTD^DPTLK6/3023
  1. ; ^ORD(101.24/3429
  1. ; EN1^GMRVUT0/1446
  1. ; $$GETACT^DGPFAPI/3860
  1. ; File #40.8/2817
  1. ; $$GET^XPAR/2263
  1. ; $$GET1^DIQ/2056
  1. ; XMD/10070
  1. ; RPCVIC^DPTLK/5888
  1. ; File #42/1377
  1. ;
  1. ;*70 - remove restriction of allowing BCMA to view Discharged
  1. ; patients
  1. ; - add Tag GETLIST, RPC:PSB CLINICLIST (returns requested
  1. ; clinic names)
  1. ; - add to User load & User save 2 new varaibles, 1 for Last
  1. ; Order mode and other for Last Clinic name search text
  1. ; - 1489: Blended PSB*3*66 with PSB*3*70
  1. ; - Add Registration API call to support VIC 4.0 cards
  1. ;
  1. FMDATE(RESULTS,X) ;
  1. ; RPC: PSB FMDATE
  1. ; Descr: Returns FM Date/Time from Clnt DateToStr()
  1. ;
  1. I $P(X,"@",2)="0000" S $P(X,"@",2)="0001"
  1. ;if no time for dates like T-1, append the current time
  1. I $P(X,"@",2)="",X'?1"N" D S $P(X,"@",2)=$P(Y,"@",2)
  1. . N X
  1. . S X="N",%DT="T" D ^%DT,DD^%DT
  1. S %DT="T" D ^%DT
  1. I +Y<1 S RESULTS(0)="-1^Invalid Date/Time" Q
  1. S RESULTS(0)=Y D D^DIQ
  1. S RESULTS(0)=RESULTS(0)_U_Y
  1. Q
  1. ;
  1. USRLOAD(RESULTS,DUMMY) ;
  1. ;
  1. ; RPC: PSB USERLOAD
  1. ; Descr: Load wkst user
  1. ;
  1. S RESULTS(0)=DUZ ;UsrIEN
  1. S RESULTS(1)=$$GET1^DIQ(200,DUZ_",",.01) ; Usr Nm
  1. S RESULTS(2)=$S($D(^XUSEC("PSB STUDENT",DUZ)):1,1:0) ; Studnt?
  1. S RESULTS(3)=$S($D(^XUSEC("PSB MANAGER",DUZ)):1,1:0) ; Mgr?
  1. S RESULTS(4)=$S($D(^XUSEC("PSB CPRS MED BUTTON",DUZ)):1,1:0)
  1. S RESULTS(5)=$$GET^XPAR("USR","PSB WINDOW")
  1. ;VDL Strng
  1. S X=$S(+$$GET^XPAR("ALL","PSB VDL INCL CONT"):"T",1:"F")
  1. S X=X_"/"_$S(+$$GET^XPAR("ALL","PSB VDL INCL PRN"):"T",1:"F")
  1. S X=X_"/"_$S(+$$GET^XPAR("ALL","PSB VDL INCL ONE-TIME"):"T",1:"F")
  1. S X=X_"/"_$S(+$$GET^XPAR("ALL","PSB VDL INCL ON-CALL"):"T",1:"F")
  1. S X=X_"/"_+$$GET^XPAR("ALL","PSB VDL SORT COLUMN")
  1. S X=X_"/"_+$$GET^XPAR("ALL","PSB VDL PB SORT COLUMN")
  1. S X=X_"/"_+$$GET^XPAR("ALL","PSB VDL IV SORT COLUMN")
  1. ;
  1. S RESULTS(6)=X ;VDL Setp
  1. S RESULTS(7)=+$G(DUZ(2))
  1. I RESULTS(7) S RESULTS(8)=$$GET1^DIQ(4,RESULTS(7)_",",.01)
  1. E S RESULTS(8)="Undefined Division"
  1. N DVIEN S DVIEN=$O(^DG(40.8,"AD",RESULTS(7),""))
  1. S RESULTS(7)=RESULTS(7)_U_$P($$SITE^VASITE(DT,DVIEN),U,3)
  1. I $T(PROD^XUPROD)]"" S RESULTS(7)=RESULTS(7)_U_$$PROD^XUPROD(1)
  1. S RESULTS(9)=+$$GET^XPAR("DIV","PSB ADMIN ESIG")
  1. S RESULTS(10)=+$$GET^XPAR("DIV","PSB ONLINE")
  1. S RESULTS(11)=$G(DTIME,300)
  1. S RESULTS(12)=$$GET^XPAR("USR","PSB UNIT DOSE COLUMN WIDTHS")
  1. S RESULTS(13)=$J_"^"_$$BASE^XLFUTL($J,10,16)
  1. S RESULTS(14)=$$GET^XPAR("USR","PSB IVPB COLUMN WIDTHS")
  1. S RESULTS(15)=$$GET^XPAR("USR","PSB IV COLUMN WIDTHS")
  1. S RESULTS(16)=$$GET^XPAR("USR","PSB PRINTER USER DEFAULT")
  1. S RESULTS(17)=$$GET^XPAR("USR","PSB GUI DEFAULT PRINTER")
  1. S RESULTS(18)=$S($D(^XUSEC("PSB READ ONLY",DUZ)):1,1:0)
  1. S RESULTS(19)=$$GET^XPAR("USR","PSB COVERSHEET VIEWS COL SORT")
  1. S RESULTS(20)=$$GET^XPAR("USR","PSB COVERSHEET V1 COL WIDTHS")
  1. S RESULTS(21)=$$GET^XPAR("USR","PSB COVERSHEET V2 COL WIDTHS")
  1. S RESULTS(22)=$$GET^XPAR("USR","PSB COVERSHEET V3 COL WIDTHS")
  1. S RESULTS(23)=$$GET^XPAR("USR","PSB COVERSHEET V4 COL WIDTHS")
  1. S RESULTS(24)=$S($D(^XUSEC("PSB UNABLE TO SCAN",DUZ)):1,1:0)
  1. S RESULTS(25)=$$GET^XPAR("DIV","PSB 5 RIGHTS UNITDOSE")
  1. S RESULTS(26)=$$GET^XPAR("DIV","PSB 5 RIGHTS IV")
  1. S RESULTS(27)=$G(DUZ("AG")) ;IHS/MSC/PLS
  1. S RESULTS(28)=$$GET^XPAR("USR","PSB ORDER MODE") ;*70
  1. S RESULTS(29)=$$GET^XPAR("USR","PSB CLINIC SEARCH") ;*70
  1. Q
  1. ;
  1. USRSAVE(RESULTS,PSBWIN,PSBVDL,PSBUDCW,PSBPBCW,PSBIVCW,PSBDEV,PSBCSRT,PSBCV1,PSBCV2,PSBCV3,PSBCV4,PSBORMODE,PSBCLSRCH) ;
  1. ;
  1. ; RPC: PSB USERSAVE
  1. ; Descr: Saves user settings.
  1. ;
  1. S RESULTS(0)="-1^FAILED - Parameters Save"
  1. S PSBWIN=$G(PSBWIN),PSBVDL=$G(PSBVDL),PSBUDCW=$G(PSBUDCW)
  1. S PSBPBCW=$G(PSBPBCW),PSBIVCW=$G(PSBIVCW),PSBDEV=$G(PSBDEV)
  1. S PSBCSRT=$G(PSBCSRT),PSBCV1=$G(PSBCV1),PSBCV2=$G(PSBCV2),PSBCV3=$G(PSBCV3),PSBCV4=$G(PSBCV4)
  1. ;
  1. D EN^XPAR("USR","PSB WINDOW",1,PSBWIN)
  1. D EN^XPAR("USR","PSB VDL INCL CONT",1,$P(PSBVDL,"/",1)["T")
  1. D EN^XPAR("USR","PSB VDL INCL PRN",1,$P(PSBVDL,"/",2)["T")
  1. D EN^XPAR("USR","PSB VDL INCL ONE-TIME",1,$P(PSBVDL,"/",3)["T")
  1. D EN^XPAR("USR","PSB VDL INCL ON-CALL",1,$P(PSBVDL,"/",4)["T")
  1. D EN^XPAR("USR","PSB VDL SORT COLUMN",1,+$P(PSBVDL,"/",5))
  1. D EN^XPAR("USR","PSB VDL PB SORT COLUMN",1,+$P(PSBVDL,"/",6))
  1. D EN^XPAR("USR","PSB VDL IV SORT COLUMN",1,+$P(PSBVDL,"/",7))
  1. D EN^XPAR("USR","PSB UNIT DOSE COLUMN WIDTHS",1,PSBUDCW)
  1. D EN^XPAR("USR","PSB IVPB COLUMN WIDTHS",1,PSBPBCW)
  1. D EN^XPAR("USR","PSB IV COLUMN WIDTHS",1,PSBIVCW)
  1. D EN^XPAR("USR","PSB GUI DEFAULT PRINTER",1,PSBDEV)
  1. D EN^XPAR("USR","PSB COVERSHEET VIEWS COL SORT",1,PSBCSRT)
  1. D EN^XPAR("USR","PSB COVERSHEET V1 COL WIDTHS",1,PSBCV1)
  1. D EN^XPAR("USR","PSB COVERSHEET V2 COL WIDTHS",1,PSBCV2)
  1. D EN^XPAR("USR","PSB COVERSHEET V3 COL WIDTHS",1,PSBCV3)
  1. D EN^XPAR("USR","PSB COVERSHEET V4 COL WIDTHS",1,PSBCV4)
  1. D EN^XPAR("USR","PSB ORDER MODE",1,PSBORMODE) ;*70
  1. D EN^XPAR("USR","PSB CLINIC SEARCH",1,PSBCLSRCH) ;*70
  1. S RESULTS(0)="1^Parameters Saved"
  1. Q
  1. ;
  1. INST(RESULTS,PSBACC,PSBVER) ;
  1. ;
  1. ; RPC: PSB INSTRUCTOR
  1. ; Descr:
  1. ; Used by frmInstructor to validate an instructor(s) at
  1. ; the client via encrypted A/V Code.
  1. ;
  1. S PSBACC=$$DECRYP^XUSRB1(PSBACC)
  1. S PSBVER=$$DECRYP^XUSRB1(PSBVER)
  1. S PSBINST=$$CHECKAV^XUSRB(PSBACC_";"_PSBVER)
  1. I PSBINST<1 S RESULTS(0)="-1^Invalid Instructor Sign-On" K PSBINST Q
  1. I '$D(^XUSEC("PSB INSTRUCTOR",PSBINST)) S RESULTS(0)="-1^Instructor doesn't have authority" K PSBINST Q
  1. S PSBINST(0)=$$GET1^DIQ(200,PSBINST_",",.01)
  1. S RESULTS(0)=PSBINST_U_PSBINST(0)
  1. Q
  1. ;
  1. ESIG(RESULTS,PSBESIG) ;
  1. ;
  1. ; RPC: PSB VALIDATE ESIG
  1. ; Descr: Validate the data in PSBESIG against user (DUZ)
  1. ;
  1. S PSBDSIG=$P($G(PSBESIG),U,2) I PSBDSIG'="" S PSBDSIG=$$DECRYP^XUSRB1(PSBDSIG),PSBESIG=PSBDSIG
  1. I $G(PSBESIG)="" S RESULTS(0)="-1^Must Supply ESig" Q
  1. S X=PSBESIG D HASH^XUSHSHP
  1. I X'=$$GET1^DIQ(200,DUZ_",",20.4,"I") S RESULTS(0)="-1^Invalid ESig"
  1. E S RESULTS(0)="1^ESig Verified"
  1. Q
  1. ;
  1. SCANPT(RESULTS,PSBDATA) ; Lookup Pt by Full SSN
  1. ;
  1. ; RPC: PSB SCANPT
  1. ; Descr:
  1. ; File #2 lookup either by full SSN
  1. ; returns -1 on error or patient data
  1. ; Check for Interleave 2 of 5 Check Digit on SSN and remove
  1. ;
  1. N DFN,PSBWARD,PSBHDR ;[*70-1489]
  1. I "SS"[$P($G(PSBDATA),"^",3) D Q:RESULTS(1)<0
  1. .I $P($G(PSBDATA),"^")["`" S RESULTS(0)=1,RESULTS(1)="-1^Invalid Patient Lookup" Q ;Add code to disallow "`", PSB*3*86
  1. .S:$P(PSBDATA,"^")?1"0"9N.U PSBDATA=$E(PSBDATA,2,99) N PSBCNT
  1. .; IHS vs VA Agency check for Patient ID info
  1. .I $G(DUZ("AG"))'="I",$G(DUZ("AG"))'="V" S RESULTS(0)=1,RESULTS(1)="-1^Invalid Agency Code - Not IHS or VA" Q
  1. .I $G(DUZ("AG"))="I" D
  1. ..S X=-1
  1. ..I $P(PSBDATA,U)?12N S X=$$HRCNF^APSPFUNC($P(PSBDATA,U))
  1. ..S:X'>0 RESULTS(0)=1,RESULTS(1)="-1^Patient not found or # not 12 digit"
  1. .E D
  1. ..;*70 Implement VIC 4.0 cards. Old Bar code with SSN still accepted
  1. ..S DPTDATA=$P(PSBDATA,U) ;,DPTDATA=$TR(DPTDATA,"|","^") ; ST - $TR not needed
  1. ..D RPCVIC^DPTLK(.DFN,DPTDATA)
  1. ..I DFN=""!(DFN<0) S:$P(PSBDATA,U)?9N.1U DFN=$$FIND1^DIC(2,"","",DPTDATA,"SSN") S:'DFN DFN=-1 ;old SSN lookup, added full SSN check, PSB*3*76
  1. .I DFN=-1 S RESULTS(0)=1,RESULTS(1)="-1^Invalid Patient Lookup"
  1. .;*End *70 Implement VIC 4.0 cards.
  1. .Q:$G(RESULTS(1))<0
  1. .S (RESULTS(1),PSBDFN)=DFN
  1. .S PSBICN=$$GETICN^MPIF001(PSBDFN) I +PSBICN=-1 S PSBICN=""
  1. I $G(DFN)']"" D Q:+PSBDFN'>0
  1. .; CCOW !
  1. .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"
  1. .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
  1. .S (DFN,RESULTS(1))=PSBDFN
  1. .;
  1. ;*70 get registration owned data for admit date or deceased date
  1. N VADM,VA,VAIN,VAIP,VA D DEM^VADPT,IN5^VADPT
  1. N QUIT ;*70
  1. ; remove discharge test ;*70
  1. ; if patient is deceased ;*70
  1. S QUIT=0
  1. I VADM(6)'="" D Q:QUIT
  1. .S RESULTS(0)=1
  1. .S RESULTS(1)="-1^"_"This patient died "_$TR($P(VADM(6),U,2),"@"," ")
  1. .D:'$P(PSBDATA,U,2) ;not read only/limited mode
  1. ..I ($P($G(PSBDATA),U,3)'["IC")&($P($G(PSBDATA),U,3)'["DF") S QUIT=1
  1. ;
  1. ; continue to load patient data
  1. S RESULTS(1)=PSBDFN
  1. F X=1,3,4,5 S RESULTS(X+1)=$G(VADM(X))
  1. ; IHS/VA - use VA("PID") instead of VADM(2) for Pat ID
  1. S RESULTS(3)=$TR(VA("PID"),"-")_U_VA("PID")
  1. F X=3,4,5,6,7,8,9,10,11 S RESULTS(X+4)=$G(VAIP(X))
  1. ;
  1. ; IHS/MSC/PLS - 03/27/06 - Changed to call PCC Vitals based on
  1. ; parameter flag DUZ("AG")="I" and PCC Vitals package usage
  1. ; flag "BEHOVM USE VMSR"=1
  1. ;
  1. I $G(DUZ("AG"))="I",$$GET^XPAR("ALL","BEHOVM USE VMSR") D
  1. .S X=+$P($$VITAL^APSPFUNC(DFN,"HT"),U,2),X=$$VITCHT^APSPFUNC(X)\1,PSBHDR("HEIGHT")=$S(X:X_"cm",1:"*")
  1. .S X=+$P($$VITAL^APSPFUNC(DFN,"WT"),U,2),X=$$VITCWT^APSPFUNC(X)\1,PSBHDR("WEIGHT")=$S(X:X_"kg",1:"*")
  1. E D
  1. .S GMRVSTR="HT" D EN6^GMRVUTL
  1. .S X=+$P(X,U,8) S:X X=$J((X*2.54),3,0) S PSBHDR("HEIGHT")=$S(X:X_"cm",1:"*") ;Rounding correction, PSB*3*76
  1. .S GMRVSTR="WT" D EN6^GMRVUTL
  1. .S X=+$P(X,U,8) S X=$J(X/2.20462262,0,2) S PSBHDR("WEIGHT")=$S(X:X_"kg",1:"*") ;Rounding to more actuate calculation, PSB*3*86
  1. ;
  1. S $P(RESULTS(9),U,3)=$$GET1^DIQ(42,$P(RESULTS(9),U)_",",44,"I")_"^"_$$GET1^DIQ(42,$P(RESULTS(9),U)_",",44)
  1. S PSBWARD=$P($G(RESULTS(9)),U,2) D IVBAGPAR(PSBWARD) ;[*70-1489]
  1. S RESULTS(16)=PSBHDR("HEIGHT")
  1. S RESULTS(17)=PSBHDR("WEIGHT")
  1. S GMRA="0^0^111" D EN1^GMRADPT
  1. I $O(GMRAL(0)) S RESULTS(18)=1
  1. E S RESULTS(18)=0
  1. ; Means Tst
  1. D GUIMTD^DPTLK6(.PSBDATA,PSBDFN)
  1. S RESULTS(19)=+$G(PSBDATA(1))_U_$G(PSBDATA(2))_U_$G(PSBDATA(3))
  1. S PSBICN=$$GETICN^MPIF001(PSBDFN) I +PSBICN=-1 S PSBICN=""
  1. S RESULTS(20)=PSBICN
  1. S RESULTS(21)="",RESULTS(0)=21
  1. S:VADM(6)'="" RESULTS(21)="This patient died "_$TR($P(VADM(6),U,2),"@"," ")
  1. S:('VAIP(13))&('VADM(6)) RESULTS(21)="Patient not Admitted" ;*70
  1. S (RESULTS(0),PSBCNT)=22
  1. S RESULTS(PSBCNT)=""
  1. F PSBINDX=1:1:($$GETACT^DGPFAPI(PSBDFN,.PSBPTFLG)) D
  1. .Q:'$D(PSBPTFLG) Q:'$D(@(PSBPTFLG_"(PSBINDX,""FLAG"")")) S PSBPFLAG="PATFLG",$P(PSBPFLAG,U,2)=$P(@(PSBPTFLG_"(PSBINDX,""FLAG"")"),"^",2)
  1. .S $P(PSBPFLAG,U,3)=PSBINDX,PSBCNT=21+PSBINDX,RESULTS(PSBCNT)=PSBPFLAG
  1. S RESULTS(0)=PSBCNT
  1. I $D(PSBPTFLG) K @PSBPTFLG
  1. Q
  1. ;
  1. MAX(RESULTS,PSBDAYS) ;
  1. ;
  1. ; RPC: PSB MAXDAYS ; Max days user view/print MAH
  1. ;
  1. S X=$O(^ORD(101.24,"B","ORRP BCMA MAH",""))
  1. S RESULTS(0)=$$GET1^DIQ(101.24,X_",",.42)
  1. Q
  1. ;
  1. NWLIST(RESULTS,DUMMY) ; ward list - NURS LOCATION, file 211.4
  1. ;
  1. ; RPC: PSB NURS WARDLIST
  1. ;
  1. K ^TMP("PSB",$J)
  1. S PSBIEN=0 F S PSBIEN=$O(^NURSF(211.4,PSBIEN)) Q:PSBIEN'?.N D
  1. .S ^TMP("PSB",$J,$$GET1^DIQ(211.4,PSBIEN_",",.01)_" [NURS UNIT]")=PSBIEN
  1. .S PSBX=0 F S PSBX=$O(^NURSF(211.4,PSBIEN,3,PSBX)) Q:PSBX="" D
  1. ..S PSBWIEN=$P(^NURSF(211.4,PSBIEN,3,PSBX,0),"^")
  1. ..I $$GET1^DIQ(42,PSBWIEN_",",.01)]"" S ^TMP("PSB",$J,$$GET1^DIQ(42,PSBWIEN_",",.01)_" [MAS WARD]")=PSBIEN
  1. S RESULTS(0)=0
  1. S X="" F S X=$O(^TMP("PSB",$J,X)) Q:X="" D
  1. .S RESULTS(0)=RESULTS(0)+1
  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")
  1. K ^TMP("PSB",$J)
  1. Q
  1. ;
  1. VITALS(RESULTS,DFN) ;Vitals API
  1. ;
  1. ; RPC PSB VITALS
  1. ;
  1. ;Retrieve vitals from either the PCC V Measurment file or VA Vitals
  1. ; file. Based on agency code = "I" & Vitals package flag=1 for the
  1. ; PCC V Measurement file or "V" for the VA Vitals file.
  1. ;
  1. I $G(DUZ("AG"))="I",$$GET^XPAR("ALL","BEHOVM USE VMSR") D Q
  1. .K RESULTS
  1. .N PSBNOW,PSBSTRT,VITS,CNT,VTYP,LP,DATA,NODE,XREF
  1. .S XREF("TMP")="T",XREF("PU")="P",XREF("BP")="BP",XREF("RS")="R",XREF("PA")="PN"
  1. .S PSBNOW=$$NOW^XLFDT(),PSBSTRT=$$FMADD^XLFDT(PSBNOW,-168)
  1. .S CNT=0 F LP="TMP","PU","RS","BP","PA" D
  1. ..S VTYP=$$FIND1^DIC(9999999.07,"","BX",LP)
  1. ..I VTYP S VITS(CNT+1)=VTYP,CNT=CNT+1
  1. .D GRID^BEHOVM(.DATA,DFN,PSBNOW,$$FMADD^XLFDT(PSBNOW,"",-168),0,.VITS)
  1. .;BUILD RESULTS ARRAY
  1. .I '$P(@DATA@(0),U,3) D Q ; No Results
  1. ..S RESULTS(0)=1,RESULTS(1)="No Vitals to report"
  1. .S (CNT,LP)=0 F S LP=$O(@DATA@("R",LP)) Q:'LP D
  1. ..S NODE=@DATA@("R",LP)
  1. ..S RESULTS(CNT+1)=XREF($P(@DATA@(0,$P(NODE,U,2)),U,4))_U_$E($$GET1^DIQ(9000010.01,$P(NODE,U,5),1201,"I"),1,12)_U_DFN_U_$P(NODE,U,3)
  1. ..S CNT=CNT+1
  1. .S RESULTS(0)=CNT
  1. ;
  1. K RESULTS
  1. N PSBSTRT,PSBSTOP,PSBNOW
  1. S PSBDFN=DFN,GMRVSTR="T;P;R;BP;PN"
  1. D NOW^%DTC S PSBNOW=%,PSBSTRT=$$FMADD^XLFDT(PSBNOW,"",-168),PSBSTOP=PSBNOW,GMRVSTR(0)=PSBSTRT_U_PSBSTOP_U_4_U
  1. K ^UTILITY($J,"GMRVD")
  1. D EN1^GMRVUT0
  1. S PSBCNT=1
  1. I '$D(^UTILITY($J,"GMRVD")) S RESULTS(0)=PSBCNT,RESULTS(PSBCNT)="No Vitals to report" Q
  1. S PSBTYP=""
  1. F S PSBTYP=$O(^UTILITY($J,"GMRVD",PSBTYP)) Q:PSBTYP="" D
  1. .S PSBRDT=""
  1. .F S PSBRDT=$O(^UTILITY($J,"GMRVD",PSBTYP,PSBRDT)) Q:PSBRDT="" D
  1. ..S PSBIEN=""
  1. ..F S PSBIEN=$O(^UTILITY($J,"GMRVD",PSBTYP,PSBRDT,PSBIEN)) Q:PSBIEN="" D
  1. ...S PSBDATA=($G(^UTILITY($J,"GMRVD",PSBTYP,PSBRDT,PSBIEN)))
  1. ...S RESULTS(PSBCNT)=PSBTYP_U_$P(PSBDATA,U,1,2)_U_$P(PSBDATA,U,8)
  1. ...S PSBCNT=PSBCNT+1
  1. S RESULTS(0)=PSBCNT-1
  1. K ^UTILITY($J,"GMRVD"),GMRBSTR,PSBDFN,PSBTYPE,PSBDATA,PSBCNT
  1. Q
  1. ; ;[*70-1489]...start
  1. IVBAGPAR(PSBWARD) ; Send Mailman Message to owners of PSB Manager Key if IV Bag Parameters are not set for this Ward
  1. Q:PSBWARD=""
  1. N PSBCSTR,PSBWDIV,PSB,PSBIVT,PSBFLAG,PSBSTNMB,PSBINST,PSBIVPAR
  1. S PSBCSTR="^ADDITIVE^STRENGTH^BOTTLE^SOLUTION^VOLUME^INFUSION RATE^MED ROUTE^SCHEDULE^ADMIN TIME^REMARKS^OTHER PRINT INFO^PROVIDER^START DATE/TIME^STOP DATE/TIME^PROVIDER COMMENTS"
  1. S PSBWARD=$O(^DIC(42,"B",PSBWARD,""))
  1. S PSBWDIV=$$GET1^DIQ(42,PSBWARD_",",.015,"I")
  1. I $G(PSBWDIV)']"" S PSBWDIV="DIV"
  1. E S PSBWDIV=$P($$SITE^VASITE(DT,PSBWDIV),U,1),PSBWDIV="DIV.`"_PSBWDIV
  1. F PSBIVT="A","P","H","S","C" S PSBIVPAR=PSBIVT D
  1. .F PSBX=2:1 Q:$P(PSBCSTR,U,PSBX)="" S PSBIVPAR=PSBIVPAR_U_$P($P($$GET^XPAR(PSBWDIV,"PSBIV "_$P(PSBCSTR,U,PSBX),PSBIVT,"B"),U,2),"-",1),^TMP("PSBWARD",PSBX,PSBIVT)=PSBIVPAR I $P(PSBIVPAR,U,PSBX)="" S PSBFLAG=""
  1. S PSBSTNMB=$$GET1^DIQ(4,($P(PSBWDIV,"`",2)),99)
  1. S:PSBSTNMB="" PSBINST=$$GET1^DIQ(4,($P(PSBWDIV,"`",2)),.01)
  1. I $D(PSBFLAG) D
  1. .N XMDUZ,XMSUB,XMTEXT,XMY,PSBERR,PSBMG1,PSBCNT
  1. .S PSBCNT=1
  1. .I PSBSTNMB'="" S XMSUB="ACTION NEEDED! DIV "_PSBSTNMB_" IV PARAMS NOT DEFINED"
  1. .E S XMSUB=" ACTION NEEDED! INSTITUTION IV PARAMS NOT DEFINED"
  1. .S XMDUZ="BCMA PARAMETERS"
  1. .S XMTEXT="PSBERR("
  1. .S PSBMG1="" F S PSBMG1=$O(^XUSEC("PSB MANAGER",PSBMG1)) Q:PSBMG1="" S XMY(PSBMG1)=""
  1. .S PSBERR(PSBCNT)="The IV Bag Parameters are not defined",PSBCNT=PSBCNT+1
  1. .S PSBERR(PSBCNT)="for Ward '"_$$GET1^DIQ(42,PSBWARD,.01)_"', which is associated ",PSBCNT=PSBCNT+1
  1. .I PSBSTNMB'="" S PSBERR(PSBCNT)="with Facility Division #"_PSBSTNMB_" and needs to",PSBCNT=PSBCNT+1
  1. .E S PSBERR(PSBCNT)="with Institution '"_PSBINST_"' and needs to",PSBCNT=PSBCNT+1
  1. .S PSBERR(PSBCNT)="be set immediately!",PSBCNT=PSBCNT+1
  1. .S PSBERR(PSBCNT)="",PSBCNT=PSBCNT+1
  1. .I PSBSTNMB="" S PSBERR(PSBCNT)="A Station Number is not defined for",PSBCNT=PSBCNT+1 D
  1. ..S PSBERR(PSBCNT)="Institution '"_PSBINST_"'.",PSBCNT=PSBCNT+1
  1. ..S PSBERR(PSBCNT)="Please log a ticket with the VA Service Desk!!",PSBCNT=PSBCNT+1
  1. ..S PSBERR(PSBCNT)="Once a Station Number has been assigned,",PSBCNT=PSBCNT+1
  1. ..S PSBERR(PSBCNT)="please complete the following steps:",PSBCNT=PSBCNT+1
  1. .S:PSBSTNMB'="" PSBERR(PSBCNT)="To do so: ",PSBCNT=PSBCNT+1
  1. .S PSBERR(PSBCNT)="",PSBCNT=PSBCNT+1
  1. .S PSBERR(PSBCNT)="1. Log into the BCMA Parameters GUI.",PSBCNT=PSBCNT+1
  1. .S PSBERR(PSBCNT)="2. Select Facility Division Number "_PSBSTNMB_".",PSBCNT=PSBCNT+1
  1. .S PSBERR(PSBCNT)="3. Set IV Parameters desired for this Division.",PSBCNT=PSBCNT+1
  1. .S PSBERR(PSBCNT)="4. Select OK.",PSBCNT=PSBCNT+1
  1. .S PSBERR(PSBCNT)="",PSBCNT=PSBCNT+1
  1. .S PSBERR(PSBCNT)="Please log a ticket with the ",PSBCNT=PSBCNT+1
  1. .S PSBERR(PSBCNT)="VA Service Desk if you need assistance.",PSBCNT=PSBCNT+1
  1. .D ^XMD
  1. Q
  1. ; ;[*70-1489]...end
  1. GETLIST(RESULTS,PRE,CONTAIN) ; Get Clinics by name ;*70
  1. N LIN
  1. K ^TMP("PSBCLIN",$J)
  1. S RESULTS=$NAME(^TMP("PSBCLIN",$J))
  1. S LIN=0 D CLNLIST(PRE,CONTAIN,.LIN)
  1. ;set total rec counter
  1. I $D(^TMP("PSBCLIN",$J)) D
  1. . S ^TMP("PSBCLIN",$J,0)=LIN
  1. E D
  1. . S ^TMP("PSBCLIN",$J,0)=1
  1. . S ^TMP("PSBCLIN",$J,1)="-1^Invalid Clinic Lookup"
  1. Q
  1. ;
  1. CLNLIST(PR,CON,LN) ;return Clinic list in TMP by name *70
  1. N QQ,NODE0,INACTDT,NAME,REACTDT
  1. F QQ=0:0 S QQ=$O(^SC(QQ)) Q:'QQ D
  1. . S NODE0=$G(^SC(QQ,0)) Q:NODE0=""
  1. . Q:$P(NODE0,U,3)'="C" ;type Clinic
  1. . S INACTDT=+$P($G(^SC(QQ,"I")),U) ;inactive date
  1. . S REACTDT=+$P($G(^SC(QQ,"I")),U,2)
  1. . I INACTDT,INACTDT<DT I 'REACTDT!(REACTDT&((REACTDT<INACTDT)!(REACTDT>DT))) Q
  1. . S NAME=$P(NODE0,U)
  1. . I PR]"" D
  1. .. I $E(NAME,1,$L(PR))=PR,NAME[CON D
  1. ... S LN=LN+1,^TMP("PSBCLIN",$J,LN)=NAME
  1. . E D
  1. .. I NAME[CON D
  1. ... S LN=LN+1,^TMP("PSBCLIN",$J,LN)=NAME
  1. Q