PSGMAR3 ;BIR/CML3-24 HOUR MAR(HEADER,BOT) ;14 Oct 98 / 4:28 PM
;;5.0; INPATIENT MEDICATIONS ;**8,20,85,111,131**;16 DEC 97
;
;
S:'$G(PSGXDT) PSGXDT=PSGDT
S PSGFORM="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
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"
NEW PSGX S PSGX=0 D ATS(.PSGX) D:PSGX HEADER Q: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.
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 PSGX=1
W !!,"Verified Allergies:",!
F X=0:0 S X=$O(PSGVALG(X)) Q:'X W ?12,PSGVALG(X),!
W !!,"Non-Verified Allergies:",!
F X=0:0 S X=$O(PSGALG(X)) Q:'X W ?12,PSGALG(X),!
W !!,"Verified Adverse Reactions:",!
F X=0:0 S X=$O(PSGVADR(X)) Q:'X W ?12,PSGVADR(X),!
W !!,"Non-Verified Adverse Reactions:",!
F X=0:0 S X=$O(PSGADR(X)) Q:'X W ?12,PSGADR(X),!
K PSGALG,PSGADR,PSGVALG,PSGVADR
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSGMAR3 3818 printed Sep 23, 2025@19:37:37 Page 2
PSGMAR3 ;BIR/CML3-24 HOUR MAR(HEADER,BOT) ;14 Oct 98 / 4:28 PM
+1 ;;5.0; INPATIENT MEDICATIONS ;**8,20,85,111,131**;16 DEC 97
+2 ;
+3 ;
+1 if '$GET(PSGXDT)
SET PSGXDT=PSGDT
+2 SET PSGFORM="VA FORM 10-"_$SELECT(PST["C":"2970",1:"5568d")
+3 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",?60,"24 HOUR MAR",?86,PSGMARSP_" through "_PSGMARFP
+4 WRITE !?5,$PIECE($$SITE^PSGMMAR2(80),U,2),?101,"Printed on "_$$ENDTC2^PSGMI(PSGXDT)
+5 WRITE !?5,"Name: "_PPN,?62,"Weight (kg): "_WT,?103,"Loc: "_$SELECT(PWDN'["C!":PWDN,1:$PIECE($GET(^SC($PIECE(PWDN,"!",2),0)),"^"))
+6 WRITE !?6,"PID: "_PSSN,?25,"DOB: "_BD_" ("_PAGE_")",?62,"Height (cm): "_HT,?99,"Room-Bed: "_$SELECT(PWDN'["C!":PRB,1:"")
+7 WRITE !?6,"Sex: "_PSEX,?25," Dx: "_DX,?$SELECT(TD:94,1:99),$SELECT(TD:"Last Transfer: "_TD,1:"Admitted: "_$SELECT(PWDN'["C!":AD,1:""))
+8 IF '$DATA(PSGALG)
WRITE !,"Allergies: See attached list of Allergies/Adverse Reactions"
+9 NEW PSGX
SET PSGX=0
DO ATS(.PSGX)
if PSGX
DO HEADER
if PSGX
QUIT
+10 WRITE !,?49,"Admin"
+11 if $GET(PSJDIET)]""
WRITE ?57,"Diet: ",PSJDIET
+12 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
+13 WRITE !,LN1
+14 QUIT
+15 ;
ATS(PSGX) ;*** Print allergies and reactions.
+1 IF '$DATA(PSGALG)
IF '$DATA(PSGVALG)
IF '$DATA(PSGADR)
IF '$DATA(PSGVADR)
QUIT
+2 IF (PSGALG+PSGADR+PSGVALG+PSGVADR)<116
Begin DoDot:1
+3 IF PSGALG(1)["NKA"
IF (PSGVALG(1)["NKA")
SET PSGALG(1)=""
+4 IF PSGALG=20
IF (PSGALG(1)["_______")
SET PSGALG(1)=""
+5 IF PSGALG(1)]""
IF (PSGVALG(1)["NKA")
SET PSGALG(1)=""
+6 IF PSGADR=20
IF (PSGADR(1)["_______")
SET PSGADR(1)=""
+7 if PSGVALG(1)=""
SET PSGVALG(1)="No Allergy Assessment"
+8 WRITE !,"Allergies: ",PSGVALG(1)," ",PSGALG(1)," ADR: ",PSGVADR(1)," ",PSGADR(1)
End DoDot:1
QUIT
+9 SET PSGX=1
+10 WRITE !!,"Verified Allergies:",!
+11 FOR X=0:0
SET X=$ORDER(PSGVALG(X))
if 'X
QUIT
WRITE ?12,PSGVALG(X),!
+12 WRITE !!,"Non-Verified Allergies:",!
+13 FOR X=0:0
SET X=$ORDER(PSGALG(X))
if 'X
QUIT
WRITE ?12,PSGALG(X),!
+14 WRITE !!,"Verified Adverse Reactions:",!
+15 FOR X=0:0
SET X=$ORDER(PSGVADR(X))
if 'X
QUIT
WRITE ?12,PSGVADR(X),!
+16 WRITE !!,"Non-Verified Adverse Reactions:",!
+17 FOR X=0:0
SET X=$ORDER(PSGADR(X))
if 'X
QUIT
WRITE ?12,PSGADR(X),!
+18 KILL PSGALG,PSGADR,PSGVALG,PSGVADR
+19 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
