source: WorldVistAEHR/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSGMAR3.m@ 1147

Last change on this file since 1147 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.7 KB
Line 
1PSGMAR3 ;BIR/CML3-24 HOUR MAR(HEADER,BOT) ;14 Oct 98 / 4:28 PM
2 ;;5.0; INPATIENT MEDICATIONS ;**8,20,85,111,131**;16 DEC 97
3 ;
4 ;
5HEADER ; pat info
6 S:'$G(PSGXDT) PSGXDT=PSGDT
7 S PSGFORM="VA FORM 10-"_$S(PST["C":"2970",1:"5568d")
8 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
9 W !?5,$P($$SITE^PSGMMAR2(80),U,2),?101,"Printed on "_$$ENDTC2^PSGMI(PSGXDT)
10 W !?5,"Name: "_PPN,?62,"Weight (kg): "_WT,?103,"Loc: "_$S(PWDN'["C!":PWDN,1:$P($G(^SC($P(PWDN,"!",2),0)),"^"))
11 W !?6,"PID: "_PSSN,?25,"DOB: "_BD_" ("_PAGE_")",?62,"Height (cm): "_HT,?99,"Room-Bed: "_$S(PWDN'["C!":PRB,1:"")
12 W !?6,"Sex: "_PSEX,?25," Dx: "_DX,?$S(TD:94,1:99),$S(TD:"Last Transfer: "_TD,1:"Admitted: "_$S(PWDN'["C!":AD,1:""))
13 I '$D(PSGALG) W !,"Allergies: See attached list of Allergies/Adverse Reactions"
14 NEW PSGX S PSGX=0 D ATS(.PSGX) D:PSGX HEADER Q:PSGX
15 W !,?49,"Admin"
16 W:$G(PSJDIET)]"" ?57,"Diet: ",PSJDIET
17 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
18 W !,LN1
19 Q
20 ;
21ATS(PSGX) ;*** Print allergies and reactions.
22 I '$D(PSGALG),'$D(PSGVALG),'$D(PSGADR),'$D(PSGVADR) Q
23 I (PSGALG+PSGADR+PSGVALG+PSGVADR)<116 D Q
24 . I PSGALG(1)["NKA",(PSGVALG(1)["NKA") S PSGALG(1)=""
25 . I PSGALG=20,(PSGALG(1)["_______") S PSGALG(1)=""
26 . I PSGALG(1)]"",(PSGVALG(1)["NKA") S PSGALG(1)=""
27 . I PSGADR=20,(PSGADR(1)["_______") S PSGADR(1)=""
28 . S:PSGVALG(1)="" PSGVALG(1)="No Allergy Assessment"
29 . W !,"Allergies: ",PSGVALG(1)," ",PSGALG(1)," ADR: ",PSGVADR(1)," ",PSGADR(1)
30 S PSGX=1
31 W !!,"Verified Allergies:",!
32 F X=0:0 S X=$O(PSGVALG(X)) Q:'X W ?12,PSGVALG(X),!
33 W !!,"Non-Verified Allergies:",!
34 F X=0:0 S X=$O(PSGALG(X)) Q:'X W ?12,PSGALG(X),!
35 W !!,"Verified Adverse Reactions:",!
36 F X=0:0 S X=$O(PSGVADR(X)) Q:'X W ?12,PSGVADR(X),!
37 W !!,"Non-Verified Adverse Reactions:",!
38 F X=0:0 S X=$O(PSGADR(X)) Q:'X W ?12,PSGADR(X),!
39 K PSGALG,PSGADR,PSGVALG,PSGVADR
40 Q
41TMSTR ;*** Set up the Admin times to print across on the 24 hour MAR.
42 ;BHW;Added/modified next 2 lines to account for admin times between 0000 and 0059
43 N ADMINHR
44 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_"-"
45 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
46 K HRS,TIM,MPH Q
47ADD ;
48 S X1=$P(MPH,"."),X2=1 D C^%DTC S MPH=X
49 Q
50 ;
51TS(X) ;
52 K TS S TS=$S(PST["C":$L(X,"-"),1:0) F Q=1:1:$S(TS<6:6,1:TS) S TS(Q)=""
53 S:TS=1 TS(3)=$P(X,"-")
54 S:TS=2 TS(1)=$P(X,"-"),TS(5)=$P(X,"-",2)
55 S:TS=3 TS(1)=$P(X,"-"),TS(3)=$P(X,"-",2),TS(5)=$P(X,"-",3)
56 I TS>3 F Q=1:1:TS S TS(Q)=$P(X,"-",Q)
57 Q
58 ;
59BOT ; bottom of MAR
60 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)
61 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
62ENB ;
63 I $D(PSGMPG) S PSGMPG=PSGMPG+1 S PSGMPGN=$S(PSGMPGN'["LAST":"PAGE: ",1:PSGMPGN)_PSGMPG
64 W !,LN1
65 W !,"|",?12,"SIGNATURE/TITLE",?39,"| INIT | ALLERGIES | INJECTION SITES |",?87,"MED/DOSE OMITTED",?107,"| REASON | INIT |"
66 F Q=1:1:10 W !,"|"_$E(LN1,1,38)_"|------|--------------|"_BLN(Q),?82,"|"_$E(LN1,1,24)_"|"_$E(LN1,1,16)_"|------|"
67 W !,LN1,!?3,PPN,?45,PSSN,?58,"Room-Bed: "_$S(PWDN'["C!":PRB,1:""),?100,$S($D(PSGMPG):PSGMPGN,1:""),?116,PSGFORM
68 Q
Note: See TracBrowser for help on using the repository browser.