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

PSBOHDR.m

Go to the documentation of this file. 
  1. PSBOHDR ;BIRMINGHAM/EFC - REPORT HEADERS ;5/28/10 2:51pm
  1.  ;;3.0;BAR CODE MED ADMIN;**5,13,42**;Mar 2004;Build 62
  1.  ;
  1.  ; Reference/IA
  1.  ; EN6^GMRVUTL/1120
  1.  ; WARD^NURSUT5/3052
  1.  ; IN5^VADPT/10061
  1.  ; DEM^VADPT/10061
  1.  ;
  1. PT(DFN,PSBHDR,PSBCONT,PSBDT) ;
  1.  ; DFN:     Patient File IEN
  1.  ; PSBCONT: True if this is a continuation page
  1.  ; PSBDT:   Date of Pt Information (Default to DT)
  1.  W:$Y>1 @IOF
  1.  W:$X>1 !
  1.  S:'$G(PSBDT) PSBDT=DT
  1.  ; BUILD PSBHDR WITH ALL HEADER STUFF
  1.  D:'$D(PSBHDR("NAME"))
  1.  .S VAIP("D")="LAST"
  1.  .D DEM^VADPT,IN5^VADPT
  1.  .S PSBHDR("NAME")=VADM(1)
  1.  .S PSBHDR("SSN")=VA("PID")
  1.  .S PSBHDR("DOB")=$P(VADM(3),U,2)
  1.  .S PSBHDR("AGE")=VADM(4)
  1.  .S PSBHDR("SEX")=$P(VADM(5),U,2)
  1.  .S PSBHDR("MVMTTYPE")=$P(VAIP(2),U,2)
  1.  .S PSBHDR("MVMTLAST")=$P(VAIP(3),U,2)
  1.  .S PSBHDR("WARD")=$P(VAIP(5),U,2)
  1.  .S PSBHDR("ROOM")=$P(VAIP(6),U,2)
  1.  .S PSBHDR("DX")=VAIP(9)
  1.  .K VAIP,VADM,VA
  1.  .;
  1.  .;IHS/MSC/PLS - Call Vitals lookup based on agency code
  1.  .;  and PCC Vitals package usage flag "BEHOVM USE VMSR"=1
  1.  .I $G(DUZ("AG"))="I",$$GET^XPAR("ALL","BEHOVM USE VMSR") D
  1.  ..S X=+$P($$VITAL^APSPFUNC(DFN,"HT"),U,2)
  1.  ..S X=$$VITCHT^APSPFUNC(X)\1,PSBHDR("HEIGHT")=$S(X:X_"cm",1:"*")
  1.  ..S X=+$P($$VITAL^APSPFUNC(DFN,"WT"),U,2)
  1.  ..S 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=X*2.54\1 S PSBHDR("HEIGHT")=$S(X:X_"cm",1:"*")
  1.  ..S GMRVSTR="WT" D EN6^GMRVUTL
  1.  ..S X=+$P(X,U,8) S:X X=X*.45\1 S PSBHDR("WEIGHT")=$S(X:X_"kg",1:"*")
  1.  .;
  1.  .N PSBADRX D ALLR^PSBALL(.PSBADRX,DFN) S X=0,Y=""
  1.  .F  S X=$O(PSBADRX(X)) Q:'X  D
  1.  ..Q:$P(PSBADRX(X),U,1)'="ADR"  S Z=$P(PSBADRX(X),U,2) Q:Z=""
  1.  ..I $L(Y_Z)>(IOM-22) S PSBHDR("REAC",$O(PSBHDR("REAC",""),-1)+1)=Y,Y=""
  1.  ..S Y=Y_$S(Y]"":", ",1:"")_$P(PSBADRX(X),U,2)
  1.  .S:Y]"" PSBHDR("REAC",$O(PSBHDR("REAC",""),-1)+1)=Y
  1.  .I '$D(PSBHDR("REAC")) S PSBHDR("REAC",1)="No ADRs on file."
  1.  .D PSBALG
  1.  .K GMRAL,GMRVSTR,GMRA,PSBARX
  1.  .D NOW^%DTC S Y=+$E(%,1,12) D D^DIQ S PSBHDR("DATE")="Run Date: "_Y
  1.  .S PSBHDR("PAGE")=0
  1.  W $C(13),$TR($J("",IOM)," ","=")
  1.  W !,$G(PSBHDR(0))
  1.  W !,$G(PSBHDR(1)),?(IOM-$L(PSBHDR("DATE"))),PSBHDR("DATE")
  1.  S PSBHDR("PAGE")=PSBHDR("PAGE")+1
  1.  W !,$G(PSBHDR(2)),?(IOM-10),$J("Page: "_PSBHDR("PAGE"),10)
  1.  F X=3:1 Q:'$D(PSBHDR(X))  W !,PSBHDR(X)  ; More Lines If Needed
  1.  I $G(PSBCONT) W !?(IOM-35\2),"*** CONTINUED FROM PREVIOUS PAGE ***"
  1.  W !!,"Patient:",?10,PSBHDR("NAME")
  1.  W ?40,$$GET^XPAR("ALL","PSB PATIENT ID LABEL")_":",?51,PSBHDR("SSN")
  1.  W ?75,"DOB:",?82,PSBHDR("DOB")," (",PSBHDR("AGE"),")"
  1.  D:'$G(PSBCONT)
  1.  .W !,"Sex: ",?10,PSBHDR("SEX"),?40,"Ht/Wt:     ",PSBHDR("HEIGHT"),"/",PSBHDR("WEIGHT"),?75,"Ward: ",?82,PSBHDR("WARD")," Rm ",PSBHDR("ROOM")
  1.  .W !,"Dx:",?10,PSBHDR("DX"),?40,"Last Mvmt: ",PSBHDR("MVMTLAST"),?75,"Type:  ",PSBHDR("MVMTTYPE")
  1.  .; Reactions/Allergies
  1.  .W !!,"ADRs:"
  1.  .F X=0:0 S X=$O(PSBHDR("REAC",X)) Q:'X  W:$X>12 ! W ?12,PSBHDR("REAC",X)
  1.  .W !!,"Allergies:"
  1.  .F X=0:0 S X=$O(PSBHDR("ALERGY",X)) Q:'X  W:$X>12 ! W ?12,PSBHDR("ALERGY",X)
  1.  .; Local Mods Allowed Here and showup only on First Page
  1.  .; Immunizations
  1.  .;D SHOT80^ASFSHOTF
  1.  W !,$TR($J("",IOM)," ","=")
  1.  Q
  1.  ;
  1. WARD(PSBWP,PSBHDR,PSBCONT,PSBDT) ; 
  1.  ; WARD:    Nurse Location File IEN
  1.  ; PSBCONT: True if this is a continuation page
  1.  ; PSBDT:   Date of Pt Information (Default to DT)
  1.  N PSBWRDA
  1.  S:'$G(PSBDT) PSBDT=DT
  1.  I '$D(PSBHDR("DATE")) D NOW^%DTC S Y=+$E(%,1,12) D D^DIQ S PSBHDR("DATE")="Run Date: "_Y
  1.  S:'$D(PSBHDR("PAGE")) PSBHDR("PAGE")=0
  1.  W:$Y>1 @IOF
  1.  W:$X>0 !
  1.  W $TR($J("",IOM)," ","="),!,$G(PSBHDR(0)),!,$G(PSBHDR(1)),?(IOM-$L(PSBHDR("DATE"))),PSBHDR("DATE")
  1.  S PSBHDR("PAGE")=PSBHDR("PAGE")+1
  1.  W !,$G(PSBHDR(2)),?(IOM-10),$J("Page: "_PSBHDR("PAGE"),10)
  1.  F X=3:1 Q:'$D(PSBHDR(X))  W !,PSBHDR(X)  ; More Lines If Needed
  1.  I $G(PSBCONT) W !?(IOM-35\2),"*** CONTINUED FROM PREVIOUS PAGE ***"
  1.  D WARD^NURSUT5("L^"_PSBWP,.PSBWRDA)
  1.  W !!,"Ward Location: "_$P(PSBWRDA(PSBWP,.01),U,2)
  1.  S X="Division: "_$P(PSBWRDA(PSBWP,.02),U,2)
  1.  W ?(IOM-$L(X)),X,!,$TR($J("",IOM)," ","=")
  1.  Q
  1.  ;
  1. PSBALG ;
  1.  S YA=""
  1.  K PSBAL,GMRALA
  1.  S PSBLIST=""
  1.  D ALLR^PSBALL(.GMRALA,DFN)
  1.  S X="" F  S X=$O(GMRALA(X)) Q:X=""  D
  1.  .I $P(GMRALA(X),U,1)["ALL" D
  1.  ..S PSBAL($P(GMRALA(X),U,2))=""
  1.  S XAB="" F  S XAB=$O(PSBAL(XAB)) Q:XAB=""  D
  1.  .S Z=XAB
  1.  .I $L(YA_Z)>(IOM-22) S PSBHDR("ALERGY",$O(PSBHDR("ALERGY",""),-1)+1)=YA,YA=""
  1.  .S YA=YA_$S(YA]"":", ",1:"")_XAB
  1.  S:YA]"" PSBHDR("ALERGY",$O(PSBHDR("ALERGY",""),-1)+1)=YA
  1.  I '$D(PSBHDR("ALERGY")) S PSBHDR("ALERGY",1)="No Allergies on file."
  1.  Q
  1.  ;
  1. PTFTR() ; [Extrinsic] Patient Page footer
  1.  ;
  1.  I (IOSL<100) F  Q:$Y>(IOSL-6)  W !
  1.  W !,$TR($J("",IOM)," ","=")
  1.  S X="Ward: "_PSBHDR("WARD")_"  Room-Bed: "_PSBHDR("ROOM")
  1.  W !,PSBHDR("NAME"),?(IOM-11\2),PSBHDR("SSN"),?(IOM-$L(X)),X
  1.  I $G(PSBUNK) S X="Note:  ??  Indicates an administration with an *UNKNOWN* Action Status" W !!,X
  1.  Q ""
  1.  ;