source: WorldVistAEHR/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSJO2.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.6 KB
Line 
1PSJO2 ;BIRC/CML3,PR-INPATIENT ORDERS - PRINT ;17 SEP 97 / 1:41 PM
2 ;;5.0; INPATIENT MEDICATIONS ;**58**;16 DEC 97
3 ;
4 ; Reference to ^PS(51.2 is supported by DBIA 2178.
5 ; Reference to ^PS(55 is supported by DBIA 2191.
6 ; Reference to ^PSI(58.1 is supported by DBIA 2284.
7 ;
8 F S PSJC=$O(^UTILITY("PSG",$J,PSJC)) Q:PSJC="" D TF F PSJST="C","O","OC","P","R","z" S PSJDRG="" F S PSJDRG=$O(^UTILITY("PSG",$J,PSJC,PSJST,PSJDRG)) Q:PSJDRG="" S NF=^(PSJDRG) D:$Y+4>IOSL NP G:PSJNP["^" DONE D P
9 I PSJTD,$S('$D(PSGPRP):1,1:PSGPRP="P") D BOT
10 ;
11DONE ;
12 I $S('$D(PSGPRP):1,1:PSGPRP="P") K ^UTILITY("PSG",$J)
13 S PSGON=PSJON K:'$D(PSGVBW) PSGODT K C,PSJTD,DO,DOB,PSJDRG,F,GIVE,HDT,LN2,NF,ND,PSJNP,O,ON,PG,PSGID,PSGOD,RF,RTE,SCH,SD,SLS,SM,SSN,PSJST,TF,PSJU,V,WD,WDP,WS,WT Q
14 ;
15P ; data printed here
16 S O=$P(PSJDRG,"^",2),DN=$P(PSJDRG,"^"),PSJON=PSJON+1 S:'PSJTD ^TMP("PSJON",$J,PSJON)=O_PSJC W !,$J(PSJON,4),?5
17 I C["A" S ND=$S($D(^PS(55,PSGP,5,O,4)):^(4),1:""),V='$P(ND,"^",PSJU) ; $S(PSJSYSU:PSJSYSU,1:1))
18 I W $S(ND="":" ",$P(ND,"^",12):"D",$P(ND,"^",18)&($P(ND,"^",19)!V):"H",$P(ND,"^",22)&($P(ND,"^",23)!V):"H",$P(ND,"^",15)&($P(ND,"^",16)!V):"R",1:" ") W:V "->"
19 I C["N" W $S('$D(^PS(53.1,O,4)):" ",$P(^(4),"^",12):"D",1:" "),$S(PSJSYSU:"->",1:"")
20 S ND=$G(@(PSJF_O_",0)")),SCH=$G(^(2)),Y=$P($G(^(6)),"^"),DO=$G(^(.1)) I Y]"" S Y=$$ENSET^PSGSICHK(Y)
21 S RTE=$P(ND,"^",3),SM=$S('$P(ND,"^",5):0,$P(ND,"^",6):1,1:2),X=$S($P(ND,"^",9)]"":$P(ND,"^",9),1:"NF")_$E("*",$P(ND,"^",20)),PSGID=$P(SCH,"^",2),SD=$P(SCH,"^",4),SCH=$P(SCH,"^")
22 I C'["N",$P(ND,"^",22) S GIVE="*** NOT TO BE GIVEN ***"
23 E S RTE=$S('RTE:"N/F",'$D(^PS(51.2,RTE,0)):RTE,$P(^(0),"^",3)]"":$P(^(0),"^",3),$P(^(0),"^")]"":$P(^(0),"^"),1:RTE),GIVE="Give: "_$S($P(DO,"^",2)]"":$P(DO,"^",2)_" ",1:"")_" "_RTE_" "_$S(SCH]"":SCH,1:"SCHEDULE NOT FOUND")
24 S WS=$S(DO&PSGPWD:$D(^PSI(58.1,"D",+DO,PSGPWD)),1:0)
25 W ?9,$S(DN'="z":DN,1:"NOT FOUND"),?50,$S(PSJST'="z":PSJST,1:"?"),?53,$E($$ENDTC^PSGMI(PSGID),1,5),?60,$E($$ENDTC^PSGMI(SD),1,5),?67,X I NF!WS!SM W ?71 W:NF "NF " W:WS "WS " W:SM $E("HSM",SM,3)
26 W !?11,GIVE I Y]"" W !?10 F X=1:1:$L(Y," ") S V=$P(Y," ",X) W:$L(V)+$X>77 !?10 W V_" "
27 Q
28 ;
29PIV ; print IV order
30 ;
31TF ;
32 Q:PSJC["N"&'PSJTF S PSJLN2=PSJSLS_$S(PSJC["A":" - - - A C T I V E - - -",PSJC["N":" N O N - V E R I F I E D",1:" - N O N - A C T I V E -")_PSJSLS W:$D(^UTILITY("PSG",$J,PSJC)) !,PSJLN2
33 S PSJF="^PS("_$S(PSJC'["N":"55,"_PSGP_",5,",1:"53.1,") S:PSJC["N" TF=0 Q
34 ;
35NP I PSJON,'PSJTD W $C(7) R !," `^' TO QUIT ",PSJNP:DTIME W:'$T $C(7) S:'$T PSJNP="^" W:PSJNP'["^" $C(13)," ",$C(13),# Q
36 I PSJON,PSJTD D BOT
37 ;
38HEADER ; print new page, name, ssn, dob, and ward
39 S PSJPG=PSJPG+1,PSGOD=$$ENDTC^PSGMI(PSGPAD)
40 W @IOF,! W:$D(PSGPR) ?22,"U N I T D O S E P R O F I L E" W ?64,HDT,! W:$D(PSGPR) PSJSLS,PSJSLS,$E(PSJSLS,1,24),! W ?1,$P(PSGP(0),"^"),?34," Ward: ",$S(PSGPWDN]"":PSGPWDN,1:"* NF *") W:$D(PSGPR) ?75-$L(PSJPG),"Pg: ",PG-$D(PSGVWA)
41 W !?7,"PID: ",PSJPPID,?30,"WEIGHT(kg): ",PSJPWT,?48,"Sex: ",$P(PSJPSEX,"^",2),?61,"Admitted: ",$E(PSGOD,1,8),!?7,"DOB: ",DOB_" ("_AGE_")",?30,"Height(cm): ",PSJPHT
42 S PSGID=$S(PSGPDD:PSGPDD,1:PSGPTD) I PSGID W ?$S(PSGPDD:59,1:53),$S(PSGPDD:"Discharged: ",1:"Last transferred: "),$E($$ENDTC^PSGMI(PSGID),1,8)
43 W !?8,"Dx: ",$S(PSGPDX]"":PSGPDX,1:"* NF *"),?69-$L(RB),"Room-Bed: ",RB,!?1,"Reactions:" D ENRCT^PSGAPP I $D(^PS(55,PSGP,5.1)),$P(^(5.1),"^",7) W $C(7),!!?21,"** PATIENT'S ORDERS PLACED ON HOLD **"
44 I '$D(PSGVWA),$S('$D(PSGPRP):1,1:PSGPRP'="E") W !!," No.",?19,"Drug",?50,"ST Start Stop Status/Info"
45 W:PSJPG>1 !,PSJLN2 Q
46 ;
47BOT ; print name, ssn, and dob on bottom of page
48 F Q=$Y:1:IOSL-4 W !
49 W !,?2,$P(PSGP(0),"^"),?40,SSN,?60,DOB Q
Note: See TracBrowser for help on using the repository browser.