PSGMAR3 ;BIR/CML3-24 HOUR MAR(HEADER,BOT) ;25-May-2012 11:00;PLS
;;5.0; INPATIENT MEDICATIONS ;**8,20,85,1008,1013,111,131,1014**;16 DEC 97;Build 62
;
;Modified - IHS/MSC/PLS - 12/09/08 - Line HEADER+3
;Modified - IHS/MSC/MGH - 11/01/11 - Line HEADER+12
; IHS/MSC/PLS - 05/24/12 - Line ATS+25,ATS+10
S:'$G(PSGXDT) PSGXDT=PSGDT
S PSGFORM="FORM" ;"VA FORM 10-"_$S(PST["C":"2970",1:"5568d")
;S PSGMAROC=0,(MSG1,MSG2)="",PSGL=$E("|",PST["C")_" " W:$G(PSGPG)&($Y) @IOF S PSGPG=1 W !,$S(PST["C":"CONTINUOUS",1:"ONE-TIME/PRN")_" SHEET",?60,"24 HOUR MAR",?86,PSGMARSP_" through "_PSGMARFP
S PSGMAROC=0,(MSG1,MSG2)="",PSGL=$E("|",PST["C")_" " W:$G(PSGPG)&($Y) @IOF S PSGPG=1 W !,$S(PST["C":"CONTINUOUS",1:"ONE-TIME/PRN")_" SHEET",?30,"24 HOUR MAR",?60,PSGMARSP_" through "_PSGMARFP,?110,"Page ___ of ___"
W !?5,$P($$SITE^PSGMMAR2(80),U,2),?101,"Printed on "_$$ENDTC2^PSGMI(PSGXDT)
W !?5,"Name: "_PPN,?62,"Weight (kg): "_WT,?103,"Loc: "_$S(PWDN'["C!":PWDN,1:$P($G(^SC($P(PWDN,"!",2),0)),"^"))
W !?6,"PID: "_PSSN,?25,"DOB: "_BD_" ("_PAGE_")",?62,"Height (cm): "_HT,?99,"Room-Bed: "_$S(PWDN'["C!":PRB,1:"")
W !?6,"Sex: "_PSEX,?25," Dx: "_DX,?$S(TD:94,1:99),$S(TD:"Last Transfer: "_TD,1:"Admitted: "_$S(PWDN'["C!":AD,1:""))
I '$D(PSGALG) W !,"Allergies: See attached list of Allergies/Adverse Reactions"
;Updated patch 1013 to display all allergies on each page
;NEW PSGX S PSGX=0 D ATS(.PSGX) D:PSGX HEADER Q:PSGX
NEW PSGX S PSGX=0 D ATS(.PSGX)
W !,?49,"Admin"
W:$G(PSJDIET)]"" ?57,"Diet: ",PSJDIET
W !?1,"Order",?8,"Start",?20,"Stop",?49,"Times" W ?59 F X=PSGMARSD:1 S:X>24 X=1 W $S(X<10:0_X,1:X)," " Q:X=+PSGMARFD
W !,LN1
Q
;
ATS(PSGX) ;*** Print allergies and reactions.
N I,SAVE,SAVE1
I '$D(PSGALG),'$D(PSGVALG),'$D(PSGADR),'$D(PSGVADR) Q
I (PSGALG+PSGADR+PSGVALG+PSGVADR)<116 D Q
. I PSGALG(1)["NKA",(PSGVALG(1)["NKA") S PSGALG(1)=""
. I PSGALG=20,(PSGALG(1)["_______") S PSGALG(1)=""
. I PSGALG(1)]"",(PSGVALG(1)["NKA") S PSGALG(1)=""
. I PSGADR=20,(PSGADR(1)["_______") S PSGADR(1)=""
. S:PSGVALG(1)="" PSGVALG(1)="No Allergy Assessment"
. W !,"Allergies: ",PSGVALG(1)," ",PSGALG(1)," ADR: ",PSGVADR(1)," ",PSGADR(1)
.S PSGMAROC=PSGMAROC+1 ;IHS/MSC/PLS - 05/24/2012
S PSGX=1
S SAVE=$Y
W !!,"Verified Allergies:",!
F X=0:0 S X=$O(PSGVALG(X)) Q:'X W ?2,PSGVALG(X),!
W "Non-Verified Allergies:",!
F X=0:0 S X=$O(PSGALG(X)) Q:'X W ?2,PSGALG(X),!
W "Verified Adverse Reactions:",!
F X=0:0 S X=$O(PSGVADR(X)) Q:'X W ?2,PSGVADR(X),!
W "Non-Verified Adverse Reactions:",!
F X=0:0 S X=$O(PSGADR(X)) Q:'X W ?2,PSGADR(X),!
;IHS/MSC/MGH Patch 1014
;K PSGALG,PSGADR,PSGVALG,PSGVADR ;IHS/MSC/MGH 1014
S SAVE=$Y-(SAVE-3)
S SAVE1=SAVE\6
S PSGMAROC=SAVE1
S APSPATS=1
;F I=1:1:SAVE#7 W !
Q
TMSTR ;*** Set up the Admin times to print across on the 24 hour MAR.
;BHW;Added/modified next 2 lines to account for admin times between 0000 and 0059
N ADMINHR
W ?59 S MPH=PSGPLS\1,(HRS,TIM)="" F MPH=1:1:$L(TMSTR,"-") S ADMINHR=$E($P(TMSTR,"-",MPH),1,2) S:ADMINHR="00" ADMINHR=24 S HRS=HRS_ADMINHR_"-"
F Q=PSGMARSD:1 D:Q>24 ADD S:Q>24 Q=1 S QQ=$S(Q<10:"0"_Q,Q>24:"01",1:Q) S:HRS[QQ TIM=$P(HRS,"-",($F(HRS,QQ)/3)) S TIM=$S(HRS[QQ&(TIM=(QQ_"00")):QQ,HRS[QQ:TIM,1:" ") W $S(MPH_"."_QQ'<PSGLFFD:"***",($G(ONHOLD)&TIM):"HLD",1:TIM_" ") Q:Q=+PSGMARFD
K HRS,TIM,MPH Q
ADD ;
S X1=$P(MPH,"."),X2=1 D C^%DTC S MPH=X
Q
;
TS(X) ;
K TS S TS=$S(PST["C":$L(X,"-"),1:0) F Q=1:1:$S(TS<6:6,1:TS) S TS(Q)=""
S:TS=1 TS(3)=$P(X,"-")
S:TS=2 TS(1)=$P(X,"-"),TS(5)=$P(X,"-",2)
S:TS=3 TS(1)=$P(X,"-"),TS(3)=$P(X,"-",2),TS(5)=$P(X,"-",3)
I TS>3 F Q=1:1:TS S TS(Q)=$P(X,"-",Q)
Q
;
BOT ; bottom of MAR
I MSG1]"" F QQ=1:1:6 W ! W:QQ=1 ?7,"|",?19,"|" W:34[QQ ?12,$S(QQ=3:MSG1,1:MSG2) W ?55,$S(1:"|",OPST'["C":LN5,QQ<6:LN4,1:LN7)
I PSGMAROC<6 S PSGMAROC=6-PSGMAROC F Q=1:1:PSGMAROC F QQ=1:1:6 W ! W:QQ=1 ?7,"|",?19,"|" W:34[QQ ?12,$S(QQ=3:MSG1,1:MSG2) W ?55,$S(1:"",OPST'["C":LN5,QQ<6:LN4,1:LN7) I QQ=6,Q<PSGMAROC W !?7,LN2
ENB ;
I $D(PSGMPG) S PSGMPG=PSGMPG+1 S PSGMPGN=$S(PSGMPGN'["LAST":"PAGE: ",1:PSGMPGN)_PSGMPG
W !,LN1
W !,"|",?12,"SIGNATURE/TITLE",?39,"| INIT | ALLERGIES | INJECTION SITES |",?87,"MED/DOSE OMITTED",?107,"| REASON | INIT |"
F Q=1:1:10 W !,"|"_$E(LN1,1,38)_"|------|--------------|"_BLN(Q),?82,"|"_$E(LN1,1,24)_"|"_$E(LN1,1,16)_"|------|"
W !,LN1,!?3,PPN,?45,PSSN,?58,"Room-Bed: "_$S(PWDN'["C!":PRB,1:""),?100,$S($D(PSGMPG):PSGMPGN,1:""),?116,PSGFORM
Q
PSGMAR3 ;BIR/CML3-24 HOUR MAR(HEADER,BOT) ;25-May-2012 11:00;PLS
+1 ;;5.0; INPATIENT MEDICATIONS ;**8,20,85,1008,1013,111,131,1014**;16 DEC 97;Build 62
+2 ;
+3 ;Modified - IHS/MSC/PLS - 12/09/08 - Line HEADER+3
+4 ;Modified - IHS/MSC/MGH - 11/01/11 - Line HEADER+12
+5 ; IHS/MSC/PLS - 05/24/12 - Line ATS+25,ATS+10
+1 IF '$GET(PSGXDT)
SET PSGXDT=PSGDT
+2 ;"VA FORM 10-"_$S(PST["C":"2970",1:"5568d")
SET PSGFORM="FORM"
+3 ;S PSGMAROC=0,(MSG1,MSG2)="",PSGL=$E("|",PST["C")_" " W:$G(PSGPG)&($Y) @IOF S PSGPG=1 W !,$S(PST["C":"CONTINUOUS",1:"ONE-TIME/PRN")_" SHEET",?60,"24 HOUR MAR",?86,PSGMARSP_" through "_PSGMARFP
+4 SET PSGMAROC=0
SET (MSG1,MSG2)=""
SET PSGL=$EXTRACT("|",PST["C")_" "
IF $GET(PSGPG)&($Y)
WRITE @IOF
SET PSGPG=1
WRITE !,$SELECT(PST["C":"CONTINUOUS",1:"ONE-TIME/PRN")_" SHEET",?30,"24 HOUR MAR",?60,PSGMARSP_" through "_PSGMARFP,?110,"Page ___ of ___"
+5 WRITE !?5,$PIECE($$SITE^PSGMMAR2(80),U,2),?101,"Printed on "_$$ENDTC2^PSGMI(PSGXDT)
+6 WRITE !?5,"Name: "_PPN,?62,"Weight (kg): "_WT,?103,"Loc: "_$SELECT(PWDN'["C!":PWDN,1:$PIECE($GET(^SC($PIECE(PWDN,"!",2),0)),"^"))
+7 WRITE !?6,"PID: "_PSSN,?25,"DOB: "_BD_" ("_PAGE_")",?62,"Height (cm): "_HT,?99,"Room-Bed: "_$SELECT(PWDN'["C!":PRB,1:"")
+8 WRITE !?6,"Sex: "_PSEX,?25," Dx: "_DX,?$SELECT(TD:94,1:99),$SELECT(TD:"Last Transfer: "_TD,1:"Admitted: "_$SELECT(PWDN'["C!":AD,1:""))
+9 IF '$DATA(PSGALG)
WRITE !,"Allergies: See attached list of Allergies/Adverse Reactions"
+10 ;Updated patch 1013 to display all allergies on each page
+11 ;NEW PSGX S PSGX=0 D ATS(.PSGX) D:PSGX HEADER Q:PSGX
+12 NEW PSGX
SET PSGX=0
DO ATS(.PSGX)
+13 WRITE !,?49,"Admin"
+14 IF $GET(PSJDIET)]""
WRITE ?57,"Diet: ",PSJDIET
+15 WRITE !?1,"Order",?8,"Start",?20,"Stop",?49,"Times"
WRITE ?59
FOR X=PSGMARSD:1
IF X>24
SET X=1
WRITE $SELECT(X<10:0_X,1:X)," "
IF X=+PSGMARFD
QUIT
+16 WRITE !,LN1
+17 QUIT
+18 ;
ATS(PSGX) ;*** Print allergies and reactions.
+1 NEW I,SAVE,SAVE1
+2 IF '$DATA(PSGALG)
IF '$DATA(PSGVALG)
IF '$DATA(PSGADR)
IF '$DATA(PSGVADR)
QUIT
+3 IF (PSGALG+PSGADR+PSGVALG+PSGVADR)<116
Begin DoDot:1
+4 IF PSGALG(1)["NKA"
IF (PSGVALG(1)["NKA")
SET PSGALG(1)=""
+5 IF PSGALG=20
IF (PSGALG(1)["_______")
SET PSGALG(1)=""
+6 IF PSGALG(1)]""
IF (PSGVALG(1)["NKA")
SET PSGALG(1)=""
+7 IF PSGADR=20
IF (PSGADR(1)["_______")
SET PSGADR(1)=""
+8 IF PSGVALG(1)=""
SET PSGVALG(1)="No Allergy Assessment"
+9 WRITE !,"Allergies: ",PSGVALG(1)," ",PSGALG(1)," ADR: ",PSGVADR(1)," ",PSGADR(1)
+10 ;IHS/MSC/PLS - 05/24/2012
SET PSGMAROC=PSGMAROC+1
End DoDot:1
QUIT
+11 SET PSGX=1
+12 SET SAVE=$Y
+13 WRITE !!,"Verified Allergies:",!
+14 FOR X=0:0
SET X=$ORDER(PSGVALG(X))
IF 'X
QUIT
WRITE ?2,PSGVALG(X),!
+15 WRITE "Non-Verified Allergies:",!
+16 FOR X=0:0
SET X=$ORDER(PSGALG(X))
IF 'X
QUIT
WRITE ?2,PSGALG(X),!
+17 WRITE "Verified Adverse Reactions:",!
+18 FOR X=0:0
SET X=$ORDER(PSGVADR(X))
IF 'X
QUIT
WRITE ?2,PSGVADR(X),!
+19 WRITE "Non-Verified Adverse Reactions:",!
+20 FOR X=0:0
SET X=$ORDER(PSGADR(X))
IF 'X
QUIT
WRITE ?2,PSGADR(X),!
+21 ;IHS/MSC/MGH Patch 1014
+22 ;K PSGALG,PSGADR,PSGVALG,PSGVADR ;IHS/MSC/MGH 1014
+23 SET SAVE=$Y-(SAVE-3)
+24 SET SAVE1=SAVE\6
+25 SET PSGMAROC=SAVE1
+26 SET APSPATS=1
+27 ;F I=1:1:SAVE#7 W !
+28 QUIT
TMSTR ;*** Set up the Admin times to print across on the 24 hour MAR.
+1 ;BHW;Added/modified next 2 lines to account for admin times between 0000 and 0059
+2 NEW ADMINHR
+3 WRITE ?59
SET MPH=PSGPLS\1
SET (HRS,TIM)=""
FOR MPH=1:1:$LENGTH(TMSTR,"-")
SET ADMINHR=$EXTRACT($PIECE(TMSTR,"-",MPH),1,2)
IF ADMINHR="00"
SET ADMINHR=24
SET HRS=HRS_ADMINHR_"-"
+4 FOR Q=PSGMARSD:1
IF Q>24
DO ADD
IF Q>24
SET Q=1
SET QQ=$SELECT(Q<10:"0"_Q,Q>24:"01",1:Q)
IF HRS[QQ
SET TIM=$PIECE(HRS,"-",($FIND(HRS,QQ)/3))
SET TIM=$SELECT(HRS[QQ&(TIM=(QQ_"00")):QQ,HRS[QQ:TIM,1:" ")
WRITE $SELECT(MPH_"."_QQ'<PSGLFFD:"***",($GET(ONHOLD)&TIM):"HLD",1:TIM_" ")
IF Q=+PSGMARFD
QUIT
+5 KILL HRS,TIM,MPH
QUIT
ADD ;
+1 SET X1=$PIECE(MPH,".")
SET X2=1
DO C^%DTC
SET MPH=X
+2 QUIT
+3 ;
TS(X) ;
+1 KILL TS
SET TS=$SELECT(PST["C":$LENGTH(X,"-"),1:0)
FOR Q=1:1:$SELECT(TS<6:6,1:TS)
SET TS(Q)=""
+2 IF TS=1
SET TS(3)=$PIECE(X,"-")
+3 IF TS=2
SET TS(1)=$PIECE(X,"-")
SET TS(5)=$PIECE(X,"-",2)
+4 IF TS=3
SET TS(1)=$PIECE(X,"-")
SET TS(3)=$PIECE(X,"-",2)
SET TS(5)=$PIECE(X,"-",3)
+5 IF TS>3
FOR Q=1:1:TS
SET TS(Q)=$PIECE(X,"-",Q)
+6 QUIT
+7 ;
BOT ; bottom of MAR
+1 IF MSG1]""
FOR QQ=1:1:6
WRITE !
IF QQ=1
WRITE ?7,"|",?19,"|"
IF 34[QQ
WRITE ?12,$SELECT(QQ=3:MSG1,1:MSG2)
WRITE ?55,$SELECT(1:"|",OPST'["C":LN5,QQ<6:LN4,1:LN7)
+2 IF PSGMAROC<6
SET PSGMAROC=6-PSGMAROC
FOR Q=1:1:PSGMAROC
FOR QQ=1:1:6
WRITE !
IF QQ=1
WRITE ?7,"|",?19,"|"
IF 34[QQ
WRITE ?12,$SELECT(QQ=3:MSG1,1:MSG2)
WRITE ?55,$SELECT(1:"",OPST'["C":LN5,QQ<6:LN4,1:LN7)
IF QQ=6
IF Q<PSGMAROC
WRITE !?7,LN2
ENB ;
+1 IF $DATA(PSGMPG)
SET PSGMPG=PSGMPG+1
SET PSGMPGN=$SELECT(PSGMPGN'["LAST":"PAGE: ",1:PSGMPGN)_PSGMPG
+2 WRITE !,LN1
+3 WRITE !,"|",?12,"SIGNATURE/TITLE",?39,"| INIT | ALLERGIES | INJECTION SITES |",?87,"MED/DOSE OMITTED",?107,"| REASON | INIT |"
+4 FOR Q=1:1:10
WRITE !,"|"_$EXTRACT(LN1,1,38)_"|------|--------------|"_BLN(Q),?82,"|"_$EXTRACT(LN1,1,24)_"|"_$EXTRACT(LN1,1,16)_"|------|"
+5 WRITE !,LN1,!?3,PPN,?45,PSSN,?58,"Room-Bed: "_$SELECT(PWDN'["C!":PRB,1:""),?100,$SELECT($DATA(PSGMPG):PSGMPGN,1:""),?116,PSGFORM
+6 QUIT
