PSBOHDR ;BIRMINGHAM/EFC - REPORT HEADERS ;12/12/12 12:12pm
;;3.0;BAR CODE MED ADMIN;**5,13,42,74,70,76,86**;Mar 2004;Build 5
;Per VA Directive 6402, this routine should not be modified.
;
; Reference/IA
; EN6^GMRVUTL/1120
; WARD^NURSUT5/3052
; IN5^VADPT/10061
; DEM^VADPT/10061
;
;*70 - add to heading CLINIC ORDERS ONLY when in clinic exclusive
; mode
; - 1489: Blended PSB*3*74 with PSB*3*70
;
PT(DFN,PSBHDR,PSBCONT,PSBDT,SRCHTXT,SUBHD) ;
; DFN: Patient File IEN
; PSBCONT: True if this is a continuation page
; PSBDT: Date of Pt Information (Default to DT)
; SRCHTXT: User selection list
; SUBHD: Sub heading if present - prints before body === line
S SRCHTXT=$G(SRCHTXT),SUBHD=$G(SUBHD) ;*70
W:$Y>1 @IOF
W:$X>1 !
S:'$G(PSBDT) PSBDT=DT
; BUILD PSBHDR WITH ALL HEADER STUFF
D:'$D(PSBHDR("NAME"))
.S VAIP("D")="LAST"
.D DEM^VADPT,IN5^VADPT
.S PSBHDR("NAME")=VADM(1)
.S PSBHDR("SSN")=VA("PID")
.S PSBHDR("DOB")=$P(VADM(3),U,2)
.S PSBHDR("AGE")=VADM(4)
.S PSBHDR("SEX")=$P(VADM(5),U,2)
.S PSBHDR("MVMTTYPE")=$P(VAIP(2),U,2)
.S PSBHDR("MVMTLAST")=$P(VAIP(3),U,2)
.S PSBHDR("WARD")=$S(PSBHDR("MVMTTYPE")="DISCHARGE":"",1:$P(VAIP(5),U,2)) ;Don't display ward upon discharge - PSB*3*86
.S PSBHDR("ROOM")=$S(PSBHDR("MVMTTYPE")="DISCHARGE":"",1:$P(VAIP(6),U,2)) ;Don't display room upon discharge - PSB*3*86
.S PSBHDR("DX")=$S(PSBHDR("MVMTTYPE")="DISCHARGE":"",1:VAIP(9)) ;;Don't display diagnosis upon discharge - PSB*3*86
.K VAIP,VADM,VA
.;
.;IHS/MSC/PLS - Call Vitals lookup based on agency code
.; and PCC Vitals package usage flag "BEHOVM USE VMSR"=1
.I $G(DUZ("AG"))="I",$$GET^XPAR("ALL","BEHOVM USE VMSR") D
..S X=+$P($$VITAL^APSPFUNC(DFN,"HT"),U,2)
..S X=$$VITCHT^APSPFUNC(X)\1,PSBHDR("HEIGHT")=$S(X:X_"cm",1:"*")
..S X=+$P($$VITAL^APSPFUNC(DFN,"WT"),U,2)
..S X=$$VITCWT^APSPFUNC(X)\1,PSBHDR("WEIGHT")=$S(X:X_"kg",1:"*")
.E D
..S GMRVSTR="HT" D EN6^GMRVUTL
..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
..S GMRVSTR="WT" D EN6^GMRVUTL
..S X=+$P(X,U,8) S:X X=$J(X/2.20462262,0,2) S PSBHDR("WEIGHT")=$S(X:X_"kg",1:"*") ;Rounding more exact, PSB*3*86
.;
.N PSBADRX D ALLR^PSBALL(.PSBADRX,DFN) S X=0,Y=""
.F S X=$O(PSBADRX(X)) Q:'X D
..Q:$P(PSBADRX(X),U,1)'="ADR" S Z=$P(PSBADRX(X),U,2) Q:Z=""
..I $L(Y_Z)>(IOM-22) S PSBHDR("REAC",$O(PSBHDR("REAC",""),-1)+1)=Y,Y=""
..S Y=Y_$S(Y]"":", ",1:"")_$P(PSBADRX(X),U,2)
.S:Y]"" PSBHDR("REAC",$O(PSBHDR("REAC",""),-1)+1)=Y
.I '$D(PSBHDR("REAC")) S PSBHDR("REAC",1)="No ADRs on file."
.D PSBALG
.K GMRAL,GMRVSTR,GMRA,PSBARX
.D NOW^%DTC S Y=+$E(%,1,12) D D^DIQ S PSBHDR("DATE")="Run Date: "_Y
.S PSBHDR("PAGE")=0
;
W $C(13),$TR($J("",IOM)," ","=")
;*70 insert across the board, a heading line base on the order mode
; write line after the report name. Some reports use PSBHDR(0)
; for report name others use PSBHDR(1).
W !,$G(PSBHDR(0))
; the DO report should not try to print a mode heading *70
N DORPT S DORPT=$S($P(PSBRPT(0),"-")="DO":1,1:0)
;
S PSBMODE=$S(PSBCLINORD=1:"Include Clinic Orders Only",PSBCLINORD=0:"Include Inpatient Orders Only",1:"Include Inpatient and Clinic Orders") ;*70
I 'DORPT,$G(PSBHDR(1))]"",$G(PSBHDR(0))]"" W !,PSBMODE ;*70
W !,$G(PSBHDR(1)),?(IOM-$L(PSBHDR("DATE"))),PSBHDR("DATE")
S PSBHDR("PAGE")=PSBHDR("PAGE")+1
I 'DORPT,$G(PSBHDR(1))]"",$G(PSBHDR(0))="" W !,PSBMODE ;*70
W !,$G(PSBHDR(2)),?(IOM-10),$J("Page: "_PSBHDR("PAGE"),10)
F X=3:1 Q:'$D(PSBHDR(X)) D ; More Lines If Needed ;*70
. W !,PSBHDR(X)
. I PSBHDR(X)["Clinic Search" W $$WRAP^PSBO(21,111,SRCHTXT)
. I PSBHDR(X)["Ward Location" W SRCHTXT
I $G(PSBCONT) W !?(IOM-35\2),"*** CONTINUED FROM PREVIOUS PAGE ***"
W !!,"Patient:",?10,PSBHDR("NAME")
W ?42,$$GET^XPAR("ALL","PSB PATIENT ID LABEL")_":",?53,PSBHDR("SSN")
W ?76,"DOB:",?83,PSBHDR("DOB")," (",PSBHDR("AGE"),")"
D:'$G(PSBCONT)
.W !,"Sex: ",?10,PSBHDR("SEX"),?42,"Ht/Wt:",?53,PSBHDR("HEIGHT"),"/",PSBHDR("WEIGHT"),?76,"Ward: ",?83,PSBHDR("WARD")," Rm: ",PSBHDR("ROOM") ;added colon to Rm, PSB*3*74 [1489]
.W !,"Dx:",?10,PSBHDR("DX"),?42,"Last Mvmt:",?53,PSBHDR("MVMTLAST"),?76,"Type:",?83,PSBHDR("MVMTTYPE")
.; Reactions/Allergies
.W !!,"ADRs:"
.F X=0:0 S X=$O(PSBHDR("REAC",X)) Q:'X W:$X>12 ! W ?12,PSBHDR("REAC",X)
.W !!,"Allergies:"
.F X=0:0 S X=$O(PSBHDR("ALERGY",X)) Q:'X W:$X>12 ! W ?12,PSBHDR("ALERGY",X)
.; Local Mods Allowed Here and showup only on First Page
.; Immunizations
.;D SHOT80^ASFSHOTF
W:SUBHD]"" !!,SUBHD
W !,$TR($J("",IOM)," ","=")
Q
;
WARD(PSBWP,PSBHDR,PSBCONT,PSBDT,SRCHTXT) ;
; PSBWP: Nurse Location File IEN
; PSBCONT: True if this is a continuation page
; PSBDT: Date of Pt Information (Default to DT)
N PSBWRDA
S:'$G(PSBDT) PSBDT=DT
I '$D(PSBHDR("DATE")) D NOW^%DTC S Y=+$E(%,1,12) D D^DIQ S PSBHDR("DATE")="Run Date: "_Y
S:'$D(PSBHDR("PAGE")) PSBHDR("PAGE")=0
W:$Y>1 @IOF
W:$X>0 !
W $TR($J("",IOM)," ","=")
;*70 Insert all reports, a heading line based on the order mode.
; Write line after the report name. Some reports use PSBHDR(0)
; for report name, others use PSBHDR(1).
W !,$G(PSBHDR(0))
S PSBMODE=$S(PSBCLINORD=1:"Include Clinic Orders Only",PSBCLINORD=0:"Include Inpatient Orders Only",1:"Include Inpatient and Clinic Orders") ;*70
I $G(PSBHDR(0))]"" W !,PSBMODE ;*70
W !,$G(PSBHDR(1)),?(IOM-$L(PSBHDR("DATE"))),PSBHDR("DATE")
I $G(PSBHDR(0))="" W !,PSBMODE ;*70
S PSBHDR("PAGE")=PSBHDR("PAGE")+1
W !,$G(PSBHDR(2)),?(IOM-10),$J("Page: "_PSBHDR("PAGE"),10)
F X=3:1 Q:'$D(PSBHDR(X)) D ; More Lines If Needed
. W !,PSBHDR(X)
. I PSBHDR(X)["Clinic Search" W $$WRAP^PSBO(21,111,SRCHTXT) ;*70
. I PSBHDR(X)["Ward Location" W SRCHTXT ;*70
I $G(PSBCONT) W !?(IOM-35\2),"*** CONTINUED FROM PREVIOUS PAGE ***"
D WARD^NURSUT5("L^"_PSBWP,.PSBWRDA)
S X="Division: "_$P(PSBWRDA(PSBWP,.02),U,2)
W ?(IOM-$L(X)),X,!,$TR($J("",IOM)," ","=")
Q
;
CLINIC(PSBRPT,PSBHDR,PSBCONT,PSBDT,SRCHTXT) ;
; PSBCONT: True if this is a continuation page
; PSBDT: Date of Pt Information (Default to DT)
S:'$G(PSBDT) PSBDT=DT
I '$D(PSBHDR("DATE")) D NOW^%DTC S Y=+$E(%,1,12) D D^DIQ S PSBHDR("DATE")="Run Date: "_Y
S:'$D(PSBHDR("PAGE")) PSBHDR("PAGE")=0
W:$Y>1 @IOF
W:$X>0 !
W $TR($J("",IOM)," ","=")
;*70 insert across the board, a heading line base on the order mode
; write line after the report name. Some reports use PSBHDR(0)
; for report name others use PSBHDR(1).
W !,$G(PSBHDR(0))
S PSBMODE=$S(PSBCLINORD=1:"Include Clinic Orders Only",PSBCLINORD=0:"Include Inpatient Orders Only",1:"Include Inpatient and Clinic Orders") ;*70
I $G(PSBHDR(0))]"" W !,PSBMODE ;*70
W !,$G(PSBHDR(1)),?(IOM-$L(PSBHDR("DATE"))),PSBHDR("DATE")
I $G(PSBHDR(0))="" W !,PSBMODE ;*70
S PSBHDR("PAGE")=PSBHDR("PAGE")+1
W !,$G(PSBHDR(2)),?(IOM-10),$J("Page: "_PSBHDR("PAGE"),10)
F X=3:1 Q:'$D(PSBHDR(X)) D ; More Lines If Needed ;*70
. W !,PSBHDR(X)
. I PSBHDR(X)["Clinic Search" W $$WRAP^PSBO(21,111,SRCHTXT)
. I PSBHDR(X)["Ward Location" W SRCHTXT
I $G(PSBCONT) W !?(IOM-35\2),"*** CONTINUED FROM PREVIOUS PAGE ***"
N DFN D CLIN^PSBO(.PSBRPT) M ^TMP("PSBO",$J)=^TMP("PSJCL",$J)
W !,$TR($J("",IOM)," ","=")
Q
;
PSBALG ;
S YA=""
K PSBAL,GMRALA
S PSBLIST=""
D ALLR^PSBALL(.GMRALA,DFN)
S X="" F S X=$O(GMRALA(X)) Q:X="" D
.I $P(GMRALA(X),U,1)["ALL" D
..S PSBAL($P(GMRALA(X),U,2))=""
S XAB="" F S XAB=$O(PSBAL(XAB)) Q:XAB="" D
.S Z=XAB
.I $L(YA_Z)>(IOM-22) S PSBHDR("ALERGY",$O(PSBHDR("ALERGY",""),-1)+1)=YA,YA=""
.S YA=YA_$S(YA]"":", ",1:"")_XAB
S:YA]"" PSBHDR("ALERGY",$O(PSBHDR("ALERGY",""),-1)+1)=YA
I '$D(PSBHDR("ALERGY")) S PSBHDR("ALERGY",1)="No Allergies on file."
Q
;
PTFTR() ; [Extrinsic] Patient Page footer
;
I (IOSL<100) F Q:$Y>(IOSL-6) W !
W !,$TR($J("",IOM)," ","=")
S X="Ward: "_PSBHDR("WARD")_" Room-Bed: "_PSBHDR("ROOM")
W !,PSBHDR("NAME"),?(IOM-11\2),PSBHDR("SSN"),?(IOM-$L(X)),X
I $G(PSBUNK) S X="Note: ?? Indicates an administration with an *UNKNOWN* Action Status" W !!,X
Q ""
;
SRCHLIST() ;Build appropriate Clinic or Ward/Nurse Unit Search list heading
N LIST,RPT,LBL,QQ,PSBWP,PSBWRDA
S LIST=""
; Clinic locations lookup
D:$P($G(PSBRPT(4)),U,2)="C"
. S:'$D(PSBRPT(2)) LIST="All Clinics"
. D:$D(PSBRPT(2))
.. F QQ=$O(PSBRPT(2,0)):1:$O(PSBRPT(2,"B"),-1) S RPT(PSBRPT(2,QQ,0))=""
.. S LIST=""
.. S LBL="" F S LBL=$O(RPT(LBL)) Q:LBL="" D
... I LIST="" S LIST=LBL Q
... I LIST]"" S LIST=LIST_", "_LBL
; Ward location lookup
WRD I $P(PSBRPT(.1),U)="W" D
. S PSBWP=$P(PSBRPT(.1),U,3) D WARD^NURSUT5("L^"_PSBWP,.PSBWRDA)
. S WLOC=PSBWRDA(PSBWP,.01)
. ; name if a nurs unit
. S LIST=$P(WLOC,U,2)
. ; hosp/ward loc name if not nurs unit
. S:LIST="" LIST=$$GET1^DIQ(44,+WLOC,.01)
Q LIST
;
EMPTYHDR(SRCHTXT) ; Write headings & search cirtieria - for no data scenario
D NOW^%DTC S Y=+$E(%,1,12) D D^DIQ S PSBHDR("DATE")="Run Date: "_Y
S PSBHDR("PAGE")=1
;
W !,$TR($J("",IOM)," ","=")
W !,$G(PSBHDR(0))
S PSBMODE=$S(PSBCLINORD=1:"Include Clinic Orders Only",PSBCLINORD=0:"Include Inpatient Orders Only",1:"Include Inpatient and Clinic Orders") ;*70
I $G(PSBHDR(1))]"",$G(PSBHDR(0))]"" W !,PSBMODE
W !,$G(PSBHDR(1)),?(IOM-$L(PSBHDR("DATE"))),PSBHDR("DATE")
I $G(PSBHDR(1))]"",$G(PSBHDR(0))="" W !,PSBMODE
W !,$G(PSBHDR(2)),?(IOM-10),$J("Page: "_PSBHDR("PAGE"),10)
F X=3:1 Q:'$D(PSBHDR(X)) D ; More Lines If Needed
. W !,PSBHDR(X)
. I PSBHDR(X)["Clinic Search" W $$WRAP^PSBO(21,111,SRCHTXT)
. I PSBHDR(X)["Ward Location" W SRCHTXT
W !,$TR($J("",IOM)," ","=")
Q ""
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSBOHDR 9913 printed Nov 22, 2024@16:50:46 Page 2
PSBOHDR ;BIRMINGHAM/EFC - REPORT HEADERS ;12/12/12 12:12pm
+1 ;;3.0;BAR CODE MED ADMIN;**5,13,42,74,70,76,86**;Mar 2004;Build 5
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; Reference/IA
+5 ; EN6^GMRVUTL/1120
+6 ; WARD^NURSUT5/3052
+7 ; IN5^VADPT/10061
+8 ; DEM^VADPT/10061
+9 ;
+10 ;*70 - add to heading CLINIC ORDERS ONLY when in clinic exclusive
+11 ; mode
+12 ; - 1489: Blended PSB*3*74 with PSB*3*70
+13 ;
PT(DFN,PSBHDR,PSBCONT,PSBDT,SRCHTXT,SUBHD) ;
+1 ; DFN: Patient File IEN
+2 ; PSBCONT: True if this is a continuation page
+3 ; PSBDT: Date of Pt Information (Default to DT)
+4 ; SRCHTXT: User selection list
+5 ; SUBHD: Sub heading if present - prints before body === line
+6 ;*70
SET SRCHTXT=$GET(SRCHTXT)
SET SUBHD=$GET(SUBHD)
+7 if $Y>1
WRITE @IOF
+8 if $X>1
WRITE !
+9 if '$GET(PSBDT)
SET PSBDT=DT
+10 ; BUILD PSBHDR WITH ALL HEADER STUFF
+11 if '$DATA(PSBHDR("NAME"))
Begin DoDot:1
+12 SET VAIP("D")="LAST"
+13 DO DEM^VADPT
DO IN5^VADPT
+14 SET PSBHDR("NAME")=VADM(1)
+15 SET PSBHDR("SSN")=VA("PID")
+16 SET PSBHDR("DOB")=$PIECE(VADM(3),U,2)
+17 SET PSBHDR("AGE")=VADM(4)
+18 SET PSBHDR("SEX")=$PIECE(VADM(5),U,2)
+19 SET PSBHDR("MVMTTYPE")=$PIECE(VAIP(2),U,2)
+20 SET PSBHDR("MVMTLAST")=$PIECE(VAIP(3),U,2)
+21 ;Don't display ward upon discharge - PSB*3*86
SET PSBHDR("WARD")=$SELECT(PSBHDR("MVMTTYPE")="DISCHARGE":"",1:$PIECE(VAIP(5),U,2))
+22 ;Don't display room upon discharge - PSB*3*86
SET PSBHDR("ROOM")=$SELECT(PSBHDR("MVMTTYPE")="DISCHARGE":"",1:$PIECE(VAIP(6),U,2))
+23 ;;Don't display diagnosis upon discharge - PSB*3*86
SET PSBHDR("DX")=$SELECT(PSBHDR("MVMTTYPE")="DISCHARGE":"",1:VAIP(9))
+24 KILL VAIP,VADM,VA
+25 ;
+26 ;IHS/MSC/PLS - Call Vitals lookup based on agency code
+27 ; and PCC Vitals package usage flag "BEHOVM USE VMSR"=1
+28 IF $GET(DUZ("AG"))="I"
IF $$GET^XPAR("ALL","BEHOVM USE VMSR")
Begin DoDot:2
+29 SET X=+$PIECE($$VITAL^APSPFUNC(DFN,"HT"),U,2)
+30 SET X=$$VITCHT^APSPFUNC(X)\1
SET PSBHDR("HEIGHT")=$SELECT(X:X_"cm",1:"*")
+31 SET X=+$PIECE($$VITAL^APSPFUNC(DFN,"WT"),U,2)
+32 SET X=$$VITCWT^APSPFUNC(X)\1
SET PSBHDR("WEIGHT")=$SELECT(X:X_"kg",1:"*")
End DoDot:2
+33 IF '$TEST
Begin DoDot:2
+34 SET GMRVSTR="HT"
DO EN6^GMRVUTL
+35 ;Rounding correction, PSB*3*76
SET X=+$PIECE(X,U,8)
if X
SET X=$JUSTIFY((X*2.54),3,0)
SET PSBHDR("HEIGHT")=$SELECT(X:X_"cm",1:"*")
+36 SET GMRVSTR="WT"
DO EN6^GMRVUTL
+37 ;Rounding more exact, PSB*3*86
SET X=+$PIECE(X,U,8)
if X
SET X=$JUSTIFY(X/2.20462262,0,2)
SET PSBHDR("WEIGHT")=$SELECT(X:X_"kg",1:"*")
End DoDot:2
+38 ;
+39 NEW PSBADRX
DO ALLR^PSBALL(.PSBADRX,DFN)
SET X=0
SET Y=""
+40 FOR
SET X=$ORDER(PSBADRX(X))
if 'X
QUIT
Begin DoDot:2
+41 if $PIECE(PSBADRX(X),U,1)'="ADR"
QUIT
SET Z=$PIECE(PSBADRX(X),U,2)
if Z=""
QUIT
+42 IF $LENGTH(Y_Z)>(IOM-22)
SET PSBHDR("REAC",$ORDER(PSBHDR("REAC",""),-1)+1)=Y
SET Y=""
+43 SET Y=Y_$SELECT(Y]"":", ",1:"")_$PIECE(PSBADRX(X),U,2)
End DoDot:2
+44 if Y]""
SET PSBHDR("REAC",$ORDER(PSBHDR("REAC",""),-1)+1)=Y
+45 IF '$DATA(PSBHDR("REAC"))
SET PSBHDR("REAC",1)="No ADRs on file."
+46 DO PSBALG
+47 KILL GMRAL,GMRVSTR,GMRA,PSBARX
+48 DO NOW^%DTC
SET Y=+$EXTRACT(%,1,12)
DO D^DIQ
SET PSBHDR("DATE")="Run Date: "_Y
+49 SET PSBHDR("PAGE")=0
End DoDot:1
+50 ;
+51 WRITE $CHAR(13),$TRANSLATE($JUSTIFY("",IOM)," ","=")
+52 ;*70 insert across the board, a heading line base on the order mode
+53 ; write line after the report name. Some reports use PSBHDR(0)
+54 ; for report name others use PSBHDR(1).
+55 WRITE !,$GET(PSBHDR(0))
+56 ; the DO report should not try to print a mode heading *70
+57 NEW DORPT
SET DORPT=$SELECT($PIECE(PSBRPT(0),"-")="DO":1,1:0)
+58 ;
+59 ;*70
SET PSBMODE=$SELECT(PSBCLINORD=1:"Include Clinic Orders Only",PSBCLINORD=0:"Include Inpatient Orders Only",1:"Include Inpatient and Clinic Orders")
+60 ;*70
IF 'DORPT
IF $GET(PSBHDR(1))]""
IF $GET(PSBHDR(0))]""
WRITE !,PSBMODE
+61 WRITE !,$GET(PSBHDR(1)),?(IOM-$LENGTH(PSBHDR("DATE"))),PSBHDR("DATE")
+62 SET PSBHDR("PAGE")=PSBHDR("PAGE")+1
+63 ;*70
IF 'DORPT
IF $GET(PSBHDR(1))]""
IF $GET(PSBHDR(0))=""
WRITE !,PSBMODE
+64 WRITE !,$GET(PSBHDR(2)),?(IOM-10),$JUSTIFY("Page: "_PSBHDR("PAGE"),10)
+65 ; More Lines If Needed ;*70
FOR X=3:1
if '$DATA(PSBHDR(X))
QUIT
Begin DoDot:1
+66 WRITE !,PSBHDR(X)
+67 IF PSBHDR(X)["Clinic Search"
WRITE $$WRAP^PSBO(21,111,SRCHTXT)
+68 IF PSBHDR(X)["Ward Location"
WRITE SRCHTXT
End DoDot:1
+69 IF $GET(PSBCONT)
WRITE !?(IOM-35\2),"*** CONTINUED FROM PREVIOUS PAGE ***"
+70 WRITE !!,"Patient:",?10,PSBHDR("NAME")
+71 WRITE ?42,$$GET^XPAR("ALL","PSB PATIENT ID LABEL")_":",?53,PSBHDR("SSN")
+72 WRITE ?76,"DOB:",?83,PSBHDR("DOB")," (",PSBHDR("AGE"),")"
+73 if '$GET(PSBCONT)
Begin DoDot:1
+74 ;added colon to Rm, PSB*3*74 [1489]
WRITE !,"Sex: ",?10,PSBHDR("SEX"),?42,"Ht/Wt:",?53,PSBHDR("HEIGHT"),"/",PSBHDR("WEIGHT"),?76,"Ward: ",?83,PSBHDR("WARD")," Rm: ",PSBHDR("ROOM")
+75 WRITE !,"Dx:",?10,PSBHDR("DX"),?42,"Last Mvmt:",?53,PSBHDR("MVMTLAST"),?76,"Type:",?83,PSBHDR("MVMTTYPE")
+76 ; Reactions/Allergies
+77 WRITE !!,"ADRs:"
+78 FOR X=0:0
SET X=$ORDER(PSBHDR("REAC",X))
if 'X
QUIT
if $X>12
WRITE !
WRITE ?12,PSBHDR("REAC",X)
+79 WRITE !!,"Allergies:"
+80 FOR X=0:0
SET X=$ORDER(PSBHDR("ALERGY",X))
if 'X
QUIT
if $X>12
WRITE !
WRITE ?12,PSBHDR("ALERGY",X)
+81 ; Local Mods Allowed Here and showup only on First Page
+82 ; Immunizations
+83 ;D SHOT80^ASFSHOTF
End DoDot:1
+84 if SUBHD]""
WRITE !!,SUBHD
+85 WRITE !,$TRANSLATE($JUSTIFY("",IOM)," ","=")
+86 QUIT
+87 ;
WARD(PSBWP,PSBHDR,PSBCONT,PSBDT,SRCHTXT) ;
+1 ; PSBWP: Nurse Location File IEN
+2 ; PSBCONT: True if this is a continuation page
+3 ; PSBDT: Date of Pt Information (Default to DT)
+4 NEW PSBWRDA
+5 if '$GET(PSBDT)
SET PSBDT=DT
+6 IF '$DATA(PSBHDR("DATE"))
DO NOW^%DTC
SET Y=+$EXTRACT(%,1,12)
DO D^DIQ
SET PSBHDR("DATE")="Run Date: "_Y
+7 if '$DATA(PSBHDR("PAGE"))
SET PSBHDR("PAGE")=0
+8 if $Y>1
WRITE @IOF
+9 if $X>0
WRITE !
+10 WRITE $TRANSLATE($JUSTIFY("",IOM)," ","=")
+11 ;*70 Insert all reports, a heading line based on the order mode.
+12 ; Write line after the report name. Some reports use PSBHDR(0)
+13 ; for report name, others use PSBHDR(1).
+14 WRITE !,$GET(PSBHDR(0))
+15 ;*70
SET PSBMODE=$SELECT(PSBCLINORD=1:"Include Clinic Orders Only",PSBCLINORD=0:"Include Inpatient Orders Only",1:"Include Inpatient and Clinic Orders")
+16 ;*70
IF $GET(PSBHDR(0))]""
WRITE !,PSBMODE
+17 WRITE !,$GET(PSBHDR(1)),?(IOM-$LENGTH(PSBHDR("DATE"))),PSBHDR("DATE")
+18 ;*70
IF $GET(PSBHDR(0))=""
WRITE !,PSBMODE
+19 SET PSBHDR("PAGE")=PSBHDR("PAGE")+1
+20 WRITE !,$GET(PSBHDR(2)),?(IOM-10),$JUSTIFY("Page: "_PSBHDR("PAGE"),10)
+21 ; More Lines If Needed
FOR X=3:1
if '$DATA(PSBHDR(X))
QUIT
Begin DoDot:1
+22 WRITE !,PSBHDR(X)
+23 ;*70
IF PSBHDR(X)["Clinic Search"
WRITE $$WRAP^PSBO(21,111,SRCHTXT)
+24 ;*70
IF PSBHDR(X)["Ward Location"
WRITE SRCHTXT
End DoDot:1
+25 IF $GET(PSBCONT)
WRITE !?(IOM-35\2),"*** CONTINUED FROM PREVIOUS PAGE ***"
+26 DO WARD^NURSUT5("L^"_PSBWP,.PSBWRDA)
+27 SET X="Division: "_$PIECE(PSBWRDA(PSBWP,.02),U,2)
+28 WRITE ?(IOM-$LENGTH(X)),X,!,$TRANSLATE($JUSTIFY("",IOM)," ","=")
+29 QUIT
+30 ;
CLINIC(PSBRPT,PSBHDR,PSBCONT,PSBDT,SRCHTXT) ;
+1 ; PSBCONT: True if this is a continuation page
+2 ; PSBDT: Date of Pt Information (Default to DT)
+3 if '$GET(PSBDT)
SET PSBDT=DT
+4 IF '$DATA(PSBHDR("DATE"))
DO NOW^%DTC
SET Y=+$EXTRACT(%,1,12)
DO D^DIQ
SET PSBHDR("DATE")="Run Date: "_Y
+5 if '$DATA(PSBHDR("PAGE"))
SET PSBHDR("PAGE")=0
+6 if $Y>1
WRITE @IOF
+7 if $X>0
WRITE !
+8 WRITE $TRANSLATE($JUSTIFY("",IOM)," ","=")
+9 ;*70 insert across the board, a heading line base on the order mode
+10 ; write line after the report name. Some reports use PSBHDR(0)
+11 ; for report name others use PSBHDR(1).
+12 WRITE !,$GET(PSBHDR(0))
+13 ;*70
SET PSBMODE=$SELECT(PSBCLINORD=1:"Include Clinic Orders Only",PSBCLINORD=0:"Include Inpatient Orders Only",1:"Include Inpatient and Clinic Orders")
+14 ;*70
IF $GET(PSBHDR(0))]""
WRITE !,PSBMODE
+15 WRITE !,$GET(PSBHDR(1)),?(IOM-$LENGTH(PSBHDR("DATE"))),PSBHDR("DATE")
+16 ;*70
IF $GET(PSBHDR(0))=""
WRITE !,PSBMODE
+17 SET PSBHDR("PAGE")=PSBHDR("PAGE")+1
+18 WRITE !,$GET(PSBHDR(2)),?(IOM-10),$JUSTIFY("Page: "_PSBHDR("PAGE"),10)
+19 ; More Lines If Needed ;*70
FOR X=3:1
if '$DATA(PSBHDR(X))
QUIT
Begin DoDot:1
+20 WRITE !,PSBHDR(X)
+21 IF PSBHDR(X)["Clinic Search"
WRITE $$WRAP^PSBO(21,111,SRCHTXT)
+22 IF PSBHDR(X)["Ward Location"
WRITE SRCHTXT
End DoDot:1
+23 IF $GET(PSBCONT)
WRITE !?(IOM-35\2),"*** CONTINUED FROM PREVIOUS PAGE ***"
+24 NEW DFN
DO CLIN^PSBO(.PSBRPT)
MERGE ^TMP("PSBO",$JOB)=^TMP("PSJCL",$JOB)
+25 WRITE !,$TRANSLATE($JUSTIFY("",IOM)," ","=")
+26 QUIT
+27 ;
PSBALG ;
+1 SET YA=""
+2 KILL PSBAL,GMRALA
+3 SET PSBLIST=""
+4 DO ALLR^PSBALL(.GMRALA,DFN)
+5 SET X=""
FOR
SET X=$ORDER(GMRALA(X))
if X=""
QUIT
Begin DoDot:1
+6 IF $PIECE(GMRALA(X),U,1)["ALL"
Begin DoDot:2
+7 SET PSBAL($PIECE(GMRALA(X),U,2))=""
End DoDot:2
End DoDot:1
+8 SET XAB=""
FOR
SET XAB=$ORDER(PSBAL(XAB))
if XAB=""
QUIT
Begin DoDot:1
+9 SET Z=XAB
+10 IF $LENGTH(YA_Z)>(IOM-22)
SET PSBHDR("ALERGY",$ORDER(PSBHDR("ALERGY",""),-1)+1)=YA
SET YA=""
+11 SET YA=YA_$SELECT(YA]"":", ",1:"")_XAB
End DoDot:1
+12 if YA]""
SET PSBHDR("ALERGY",$ORDER(PSBHDR("ALERGY",""),-1)+1)=YA
+13 IF '$DATA(PSBHDR("ALERGY"))
SET PSBHDR("ALERGY",1)="No Allergies on file."
+14 QUIT
+15 ;
PTFTR() ; [Extrinsic] Patient Page footer
+1 ;
+2 IF (IOSL<100)
FOR
if $Y>(IOSL-6)
QUIT
WRITE !
+3 WRITE !,$TRANSLATE($JUSTIFY("",IOM)," ","=")
+4 SET X="Ward: "_PSBHDR("WARD")_" Room-Bed: "_PSBHDR("ROOM")
+5 WRITE !,PSBHDR("NAME"),?(IOM-11\2),PSBHDR("SSN"),?(IOM-$LENGTH(X)),X
+6 IF $GET(PSBUNK)
SET X="Note: ?? Indicates an administration with an *UNKNOWN* Action Status"
WRITE !!,X
+7 QUIT ""
+8 ;
SRCHLIST() ;Build appropriate Clinic or Ward/Nurse Unit Search list heading
+1 NEW LIST,RPT,LBL,QQ,PSBWP,PSBWRDA
+2 SET LIST=""
+3 ; Clinic locations lookup
+4 if $PIECE($GET(PSBRPT(4)),U,2)="C"
Begin DoDot:1
+5 if '$DATA(PSBRPT(2))
SET LIST="All Clinics"
+6 if $DATA(PSBRPT(2))
Begin DoDot:2
+7 FOR QQ=$ORDER(PSBRPT(2,0)):1:$ORDER(PSBRPT(2,"B"),-1)
SET RPT(PSBRPT(2,QQ,0))=""
+8 SET LIST=""
+9 SET LBL=""
FOR
SET LBL=$ORDER(RPT(LBL))
if LBL=""
QUIT
Begin DoDot:3
+10 IF LIST=""
SET LIST=LBL
QUIT
+11 IF LIST]""
SET LIST=LIST_", "_LBL
End DoDot:3
End DoDot:2
End DoDot:1
+12 ; Ward location lookup
WRD IF $PIECE(PSBRPT(.1),U)="W"
Begin DoDot:1
+1 SET PSBWP=$PIECE(PSBRPT(.1),U,3)
DO WARD^NURSUT5("L^"_PSBWP,.PSBWRDA)
+2 SET WLOC=PSBWRDA(PSBWP,.01)
+3 ; name if a nurs unit
+4 SET LIST=$PIECE(WLOC,U,2)
+5 ; hosp/ward loc name if not nurs unit
+6 if LIST=""
SET LIST=$$GET1^DIQ(44,+WLOC,.01)
End DoDot:1
+7 QUIT LIST
+8 ;
EMPTYHDR(SRCHTXT) ; Write headings & search cirtieria - for no data scenario
+1 DO NOW^%DTC
SET Y=+$EXTRACT(%,1,12)
DO D^DIQ
SET PSBHDR("DATE")="Run Date: "_Y
+2 SET PSBHDR("PAGE")=1
+3 ;
+4 WRITE !,$TRANSLATE($JUSTIFY("",IOM)," ","=")
+5 WRITE !,$GET(PSBHDR(0))
+6 ;*70
SET PSBMODE=$SELECT(PSBCLINORD=1:"Include Clinic Orders Only",PSBCLINORD=0:"Include Inpatient Orders Only",1:"Include Inpatient and Clinic Orders")
+7 IF $GET(PSBHDR(1))]""
IF $GET(PSBHDR(0))]""
WRITE !,PSBMODE
+8 WRITE !,$GET(PSBHDR(1)),?(IOM-$LENGTH(PSBHDR("DATE"))),PSBHDR("DATE")
+9 IF $GET(PSBHDR(1))]""
IF $GET(PSBHDR(0))=""
WRITE !,PSBMODE
+10 WRITE !,$GET(PSBHDR(2)),?(IOM-10),$JUSTIFY("Page: "_PSBHDR("PAGE"),10)
+11 ; More Lines If Needed
FOR X=3:1
if '$DATA(PSBHDR(X))
QUIT
Begin DoDot:1
+12 WRITE !,PSBHDR(X)
+13 IF PSBHDR(X)["Clinic Search"
WRITE $$WRAP^PSBO(21,111,SRCHTXT)
+14 IF PSBHDR(X)["Ward Location"
WRITE SRCHTXT
End DoDot:1
+15 WRITE !,$TRANSLATE($JUSTIFY("",IOM)," ","=")
+16 QUIT ""
