- 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 Jan 18, 2025@03:02:45 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