PSGMMAR4.m

PSGMMAR4 ;BIR/CML3-MD MARS - PRINT O/P ORDERS ;16-Nov-2012 12:16;DU

 ;;5.0; INPATIENT MEDICATIONS ;**8,12,20,1008,1013,1014,111,1015**;16 DEC 97;Build 62

 ;

 ; Modified - IHS/CIA/PLS - 06/21/04 - Line ENB+5

 ;            IHS/MSC/PLS - 12/09/08 - Line HEADER+2

 ;                          11/17/09 - Line BOT+2

 ;            IHS/MSC/MGH - 11/02/11 - Line HEADER+10

 ;            IHS/MSC/PLS - 05/24/12 - Line BOT+4

 ;            IHS/MSC/MGH - 11/16/12 - Line HEADER+4

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

 ;

HEADER ;*** Patient info

 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

 S PSGMAROC=0    ;IHS/MSC/MGH Patch 1015

 W:$G(PSGPG) @IOF S PSGPG=1 W !?1,"ONE-TIME/PRN SHEET",?31,PSGMARDF_" DAY MAR",?60,PSGMARSP_"  through  "_PSGMARFP,?110,"Page ___ of ___"

 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"

 ;Updated patch 1013 to display all allergies on each page

 ;NEW PSGX S PSGX=0 D ATS^PSGMAR3(.PSGX) D:PSGX HEADER Q:PSGX

 NEW PSGX S PSGX=0 D ATS^PSGMAR3(.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

 ;S X=$S(BL=4:25,1:19) F Q=1:1:X W !,LN31  ;IHS/MSC/PLS - Patch 1008

 S X=$S($G(APSPATS)&(BL=4):14,BL=4:25,$G(APSPATS):9,1:17) F Q=1:1:X W !,LN31  ;IHS/MSC/PLS - Patch 1014

 ;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)_"|------|"

 ; IHS/CIA/PLS - 06/21/04 - Removed reference to VA Form

 ;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

 W !,LN1,!?3,PPN,?45,PSSN,?58,"Room-Bed: "_$S(PWDN'["C!":PRB,1:""),?100,$S($D(PSGMPG):PSGMPGN,1:""),*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

PSGMMAR4  ;BIR/CML3-MD MARS - PRINT O/P ORDERS ;16-Nov-2012 12:16;DU

 +1       ;;5.0; INPATIENT MEDICATIONS ;**8,12,20,1008,1013,1014,111,1015**;16 DEC 97;Build 62

 +2       ;

 +3       ; Modified - IHS/CIA/PLS - 06/21/04 - Line ENB+5

 +4       ;            IHS/MSC/PLS - 12/09/08 - Line HEADER+2

 +5       ;                          11/17/09 - Line BOT+2

 +6       ;            IHS/MSC/MGH - 11/02/11 - Line HEADER+10

 +7       ;            IHS/MSC/PLS - 05/24/12 - Line BOT+4

 +8       ;            IHS/MSC/MGH - 11/16/12 - Line HEADER+4

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      ;

HEADER    ;*** Patient info

 +1        IF '$GET(PSGXDT)

               SET PSGXDT=PSGDT

 +2       ;W:$G(PSGPG) @IOF S PSGPG=1 W ?1,"ONE-TIME/PRN SHEET",?61,PSGMARDF_" DAY MAR",?100,PSGMARSP_"  through  "_PSGMARFP

 +3       ;IHS/MSC/MGH Patch 1015

           SET PSGMAROC=0

 +4        IF $GET(PSGPG)

               WRITE @IOF

           SET PSGPG=1

           WRITE !?1,"ONE-TIME/PRN SHEET",?31,PSGMARDF_" DAY MAR",?60,PSGMARSP_"  through  "_PSGMARFP,?110,"Page ___ of ___"

 +5        WRITE !?5,$PIECE($$SITE^PSGMMAR2(80),U,2),?102,"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^PSGMAR3(.PSGX) D:PSGX HEADER Q:PSGX

 +12       NEW PSGX

           SET PSGX=0

           DO ATS^PSGMAR3(.PSGX)

 +13       IF $GET(PSJDIET)]""

               WRITE !?57,"Diet: ",PSJDIET

 +14      IF '$TEST

               WRITE !

 +15      ;* W !!?1,"Order",?9,"Start",?21,"Stop",?77,"Order",?85,"Start",?97,"Stop",!,LN1

 +16       WRITE !?1,"Order",?9,"Start",?21,"Stop",?77,"Order",?85,"Start",?97,"Stop",!,LN1

 +17       QUIT 

 +18      ;

BOT       ; rest of PRN sheet

 +1        WRITE !,"|  DATE  |  TIME  |         MEDICATION/DOSE/ROUTE           | INIT |        REASON         |       RESULTS         |  TIME  | INIT |"

 +2       ;S X=$S(BL=4:26,1:20) F Q=1:1:X W !,LN31

 +3       ;S X=$S(BL=4:25,1:19) F Q=1:1:X W !,LN31  ;IHS/MSC/PLS - Patch 1008

 +4       ;IHS/MSC/PLS - Patch 1014

           SET X=$SELECT($GET(APSPATS)&(BL=4):14,BL=4:25,$GET(APSPATS):9,1:17)

           FOR Q=1:1:X

               WRITE !,LN31

 +5       ;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       ; IHS/CIA/PLS - 06/21/04 - Removed reference to VA Form

 +6       ;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

 +7        WRITE !,LN1,!?3,PPN,?45,PSSN,?58,"Room-Bed: "_$SELECT(PWDN'["C!":PRB,1:""),?100,$SELECT($DATA(PSGMPG):PSGMPGN,1:""),*13

 +8        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))=""

 +9        QUIT