PSGMMAR4 ;BIR/CML3-MD MARS - PRINT O/P ORDERS ;05 Oct 98 / 10:25 AM
;;5.0; INPATIENT MEDICATIONS ;**8,12,20,111**;16 DEC 97
;
PSGMARB ;***Print blank MAR for PRN orders.
NEW L1 S L1=" | |"
D HEADER F X=1:1:(BL/2) D
. F Q=1:1:6 W:Q=1 !,L1,?55,"|",?75,"| ",L1 W:Q'=1 !,?55,"|",?75,"| "
. W !,LN1
D BOT
K ^TMP($J,"1PRN")
Q
;
EN ;***Start print prn orders.
NEW LABX,L1,P1,P2 S (PG,LAB)=0,L1=" | |"
S:'$D(PSGMPG) PSGMPG=0 S PSGMPGN="PAGE: "
F S PG=$O(^TMP($J,"1PRN",PG)) Q:'PG D
. D HEADER
. F LAB=0:0 S LABX=LAB,LAB=$O(^TMP($J,"1PRN",PG,LAB)) Q:'LAB F LN=0:0 S LN=$O(^TMP($J,"1PRN",PG,LAB,LN)) Q:'LN D
.. S P1=$P(^TMP($J,"1PRN",PG,LAB,LN),U,1),P2=$P(^(LN),U,2)
.. S:LN=1 P1=$S(P1]"":P1,1:L1),P2=$S(P2]"":P2,1:L1)
.. W !,P1,?55,"|",?75,"| ",P2
.. W:'(LN#6) !,LN1
. F LABX=LABX+1:1:(BL/2) D
. .F X=1:1:6 S:X=1 (P1,P2)=L1 W !,P1,?55,"|",?75,"| ",P2 S (P1,P2)=""
. .W !,LN1
. S:'$O(^TMP($J,"1PRN",PG)) PSGMPGN="LAST PAGE: " D BOT
Q
;
S:'$G(PSGXDT) PSGXDT=PSGDT
W:$G(PSGPG) @IOF S PSGPG=1 W ?1,"ONE-TIME/PRN SHEET",?61,PSGMARDF_" DAY MAR",?100,PSGMARSP_" through "_PSGMARFP
W !?5,$P($$SITE^PSGMMAR2(80),U,2),?102,"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^PSGMAR3(.PSGX) D:PSGX HEADER Q:PSGX
I $G(PSJDIET)]"" W !?57,"Diet: ",PSJDIET
E W !
;* W !!?1,"Order",?9,"Start",?21,"Stop",?77,"Order",?85,"Start",?97,"Stop",!,LN1
W !?1,"Order",?9,"Start",?21,"Stop",?77,"Order",?85,"Start",?97,"Stop",!,LN1
Q
;
BOT ; rest of PRN sheet
W !,"| DATE | TIME | MEDICATION/DOSE/ROUTE | INIT | REASON | RESULTS | TIME | INIT |"
S X=$S(BL=4:26,1:20) F Q=1:1:X W !,LN31
;W "| | | | | | | | |"
ENB ;
I $D(PSGMPG) S PSGMPG=PSGMPG+1 S PSGMPGN=$S(PSGMPGN'["LAST":"PAGE: ",1:PSGMPGN)_PSGMPG
W !,LN1
W !,"|",?13,"SIGNATURE/TITLE",?40,"| INIT | INJECTION SITES |",?97,"SIGNATURE/TITLE",?124,"| INIT |"
F Q=1:1:10 W !,"|"_$E(LN1,1,39)_"|------|"_BLN(Q),?84,"|"_$E(LN1,1,39)_"|------|"
W !,LN1,!?3,PPN,?45,PSSN,?58,"Room-Bed: "_$S(PWDN'["C!":PRB,1:""),?100,$S($D(PSGMPG):PSGMPGN,1:""),?116,"VA FORM 10-5568d",*13
S PSGMAROC=0,(PSGMAPA(1),PSGMAPB(1),PSGMAPC(1),PSGMAPD(1))=" | |" F Q=2:1:6 S (PSGMAPA(Q),PSGMAPB(Q),PSGMAPC(Q),PSGMAPD(Q))=""
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSGMMAR4 2913 printed Dec 13, 2024@02:01:38 Page 2
PSGMMAR4 ;BIR/CML3-MD MARS - PRINT O/P ORDERS ;05 Oct 98 / 10:25 AM
+1 ;;5.0; INPATIENT MEDICATIONS ;**8,12,20,111**;16 DEC 97
+2 ;
PSGMARB ;***Print blank MAR for PRN orders.
+1 NEW L1
SET L1=" | |"
+2 DO HEADER
FOR X=1:1:(BL/2)
Begin DoDot:1
+3 FOR Q=1:1:6
if Q=1
WRITE !,L1,?55,"|",?75,"| ",L1
if Q'=1
WRITE !,?55,"|",?75,"| "
+4 WRITE !,LN1
End DoDot:1
+5 DO BOT
+6 KILL ^TMP($JOB,"1PRN")
+7 QUIT
+8 ;
EN ;***Start print prn orders.
+1 NEW LABX,L1,P1,P2
SET (PG,LAB)=0
SET L1=" | |"
+2 if '$DATA(PSGMPG)
SET PSGMPG=0
SET PSGMPGN="PAGE: "
+3 FOR
SET PG=$ORDER(^TMP($JOB,"1PRN",PG))
if 'PG
QUIT
Begin DoDot:1
+4 DO HEADER
+5 FOR LAB=0:0
SET LABX=LAB
SET LAB=$ORDER(^TMP($JOB,"1PRN",PG,LAB))
if 'LAB
QUIT
FOR LN=0:0
SET LN=$ORDER(^TMP($JOB,"1PRN",PG,LAB,LN))
if 'LN
QUIT
Begin DoDot:2
+6 SET P1=$PIECE(^TMP($JOB,"1PRN",PG,LAB,LN),U,1)
SET P2=$PIECE(^(LN),U,2)
+7 if LN=1
SET P1=$SELECT(P1]"":P1,1:L1)
SET P2=$SELECT(P2]"":P2,1:L1)
+8 WRITE !,P1,?55,"|",?75,"| ",P2
+9 if '(LN#6)
WRITE !,LN1
End DoDot:2
+10 FOR LABX=LABX+1:1:(BL/2)
Begin DoDot:2
+11 FOR X=1:1:6
if X=1
SET (P1,P2)=L1
WRITE !,P1,?55,"|",?75,"| ",P2
SET (P1,P2)=""
+12 WRITE !,LN1
End DoDot:2
+13 if '$ORDER(^TMP($JOB,"1PRN",PG))
SET PSGMPGN="LAST PAGE: "
DO BOT
End DoDot:1
+14 QUIT
+15 ;
+1 if '$GET(PSGXDT)
SET PSGXDT=PSGDT
+2 if $GET(PSGPG)
WRITE @IOF
SET PSGPG=1
WRITE ?1,"ONE-TIME/PRN SHEET",?61,PSGMARDF_" DAY MAR",?100,PSGMARSP_" through "_PSGMARFP
+3 WRITE !?5,$PIECE($$SITE^PSGMMAR2(80),U,2),?102,"Printed on ",$$ENDTC2^PSGMI(PSGXDT)
+4 WRITE !?5,"Name: "_PPN,?62,"Weight (kg): "_WT,?103,"Loc: "_$SELECT(PWDN'["C!":PWDN,1:$PIECE($GET(^SC($PIECE(PWDN,"!",2),0)),"^"))
+5 WRITE !?6,"PID: "_PSSN,?25,"DOB: "_BD_" ("_PAGE_")",?62,"Height (cm): "_HT,?99,"Room-Bed: "_$SELECT(PWDN'["C!":PRB,1:"")
+6 WRITE !?6,"Sex: "_PSEX,?25," Dx: "_DX,?$SELECT(TD:94,1:99),$SELECT(TD:"Last Transfer: "_TD,1:"Admitted: "_$SELECT(PWDN'["C!":AD,1:""))
+7 IF '$DATA(PSGALG)
WRITE !,"Allergies: See attached list of Allergies/Adverse Reactions"
+8 NEW PSGX
SET PSGX=0
DO ATS^PSGMAR3(.PSGX)
if PSGX
DO HEADER
if PSGX
QUIT
+9 IF $GET(PSJDIET)]""
WRITE !?57,"Diet: ",PSJDIET
+10 IF '$TEST
WRITE !
+11 ;* W !!?1,"Order",?9,"Start",?21,"Stop",?77,"Order",?85,"Start",?97,"Stop",!,LN1
+12 WRITE !?1,"Order",?9,"Start",?21,"Stop",?77,"Order",?85,"Start",?97,"Stop",!,LN1
+13 QUIT
+14 ;
BOT ; rest of PRN sheet
+1 WRITE !,"| DATE | TIME | MEDICATION/DOSE/ROUTE | INIT | REASON | RESULTS | TIME | INIT |"
+2 SET X=$SELECT(BL=4:26,1:20)
FOR Q=1:1:X
WRITE !,LN31
+3 ;W "| | | | | | | | |"
ENB ;
+1 IF $DATA(PSGMPG)
SET PSGMPG=PSGMPG+1
SET PSGMPGN=$SELECT(PSGMPGN'["LAST":"PAGE: ",1:PSGMPGN)_PSGMPG
+2 WRITE !,LN1
+3 WRITE !,"|",?13,"SIGNATURE/TITLE",?40,"| INIT | INJECTION SITES |",?97,"SIGNATURE/TITLE",?124,"| INIT |"
+4 FOR Q=1:1:10
WRITE !,"|"_$EXTRACT(LN1,1,39)_"|------|"_BLN(Q),?84,"|"_$EXTRACT(LN1,1,39)_"|------|"
+5 WRITE !,LN1,!?3,PPN,?45,PSSN,?58,"Room-Bed: "_$SELECT(PWDN'["C!":PRB,1:""),?100,$SELECT($DATA(PSGMPG):PSGMPGN,1:""),?116,"VA FORM 10-5568d",*13
+6 SET PSGMAROC=0
SET (PSGMAPA(1),PSGMAPB(1),PSGMAPC(1),PSGMAPD(1))=" | |"
FOR Q=2:1:6
SET (PSGMAPA(Q),PSGMAPB(Q),PSGMAPC(Q),PSGMAPD(Q))=""
+7 QUIT
