source: WorldVistAEHR/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSIVMAN1.m@ 1259

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

initial load of WorldVistAEHR

File size: 3.4 KB
Line 
1PSIVMAN1 ;BIR/RGY,PR-COMPILE MAN LIST ;07 OCT 97 / 9:35 AM
2 ;;5.0; INPATIENT MEDICATIONS ;**81**;16 DEC 97
3 ;
4 ; Reference to ^PS(55 is supported by DBIA# 2191.
5 ; Reference to ^PS(52.6 is supported by DBIA# 1231.
6 ; Reference to ^PS(52.7 is supported by DBIA# 2173.
7PRNTO ;
8 G:$S('$D(^PS(55,DFN,"IV",ON,"AD",0)):1,$P(^(0),"^",4)<1:1,1:0) SOL
9 F PSIVA=0:0 S PSIVA=$O(^PS(55,DFN,"IV",ON,"AD",PSIVA)) Q:'PSIVA S PSIVA=PSIVA_"^"_^(PSIVA,0) W !?16,$P(^PS(52.6,$P(PSIVA,"^",2),0),"^")," ",$P(PSIVA,"^",3) W:$P(PSIVA,"^",4)]"" " in bottle(s): ",$P(PSIVA,"^",4) W ?80,"Lot#: __________"
10SOL W:$E(PSIVDN,1,3)="***" !?16,"in",!?16,PSIVDN
11 G:$S('$D(^PS(55,DFN,"IV",ON,"SOL",0)):1,$P(^(0),"^",4)<1:1,1:0) PAT
12 W !?16,"in" F PSIV=0:0 S PSIV=$O(^PS(55,DFN,"IV",ON,"SOL",PSIV)) Q:'PSIV S PSIV=PSIV_"^"_^(PSIV,0) D
13 .S PSIVSL=$S($D(^PS(52.7,$P(PSIV,"^",2),0)):$P(^(0),"^")_" "_$P(PSIV,"^",3)_" "_$P(^(0),"^",4),1:"*** Undefined Solution") W !?16,PSIVSL W:$E(PSIVSL,1,3)'="***" ?80,"Lot#: __________"
14 ;
15PAT W !?4,"[",ON,"] ",?10,VADM(1)," (",$E(VADM(2),6,9),") (",$S(+VAIN(4):$P(VAIN(4),U,2),1:"Outpatient IV"),")",?62,+^PS(55,PSIVGL1,PSIVSN,PSIVGL2,PSIVT,PSIV1,PSIV2,DFN,ON) S TOTAL=TOTAL+^(ON)
16 I P(4)="S"!(P(23)="S") W ?75," Syringe size: ",$S($D(^PS(55,DFN,"IV",ON,2)):$S($P(^(2),U,4)'="":$P(^(2),U,4),1:"NF"),1:"NF")
17 S PSIV=$S($D(^PS(55,DFN,"IV",ON,3)):$P(^(3),"^"),1:"") W:PSIV]"" !?10,"Other Info.: ",PSIV S PSIV=$S($D(^(1)):$P(^(1),"^"),1:"") W:PSIV]"" !?14,"Remarks: ",$P(^(1),"^")
18 W ! K PSIVA,PSIV3,PSIV Q
19ENT ; will print man. list
20 S NOFLG=0
21 I '$D(^PS(55,PSIVGL1,PSIVSN,PSIVGL2)) S NOFLG=1,PSIVT=$G(PSIVTTM) D HDR Q
22 S PSIVT="",TOTAL=0
23 F JJ=0:0 S PSIVT=$O(^PS(55,PSIVGL1,PSIVSN,PSIVGL2,PSIVT)) D:TOTAL>0 TOTAL Q:PSIVT="" D HDR S PSIV1="" F JJ1=0:0 S PSIV1=$O(^PS(55,PSIVGL1,PSIVSN,PSIVGL2,PSIVT,PSIV1)) Q:PSIV1="" S PSIVDN=PSIV1 D:PSIVDN["^"!(PSIVDN["zz") LOOKUP D RGY1
24 K PSIVT,PSIV1,PSIV2,PSIVTEST,PSIVDN,FILE Q
25LOOKUP ; expand drug info
26 I PSIVDN?1"zz"1N S PSIVDN="*** No "_$S(PSIVDN["6":"Additive",1:"Solution") Q
27 S FILE=+("52."_+$P(PSIVDN,"^",3)),DA=$P(PSIVDN,";",2)
28 I $D(^PS(FILE,DA,0)),$P(^(0),"^")]"" S PSIVDN=$P(^(0),"^")_" "_$P(PSIVDN,"^",2)_$S(FILE[7:" "_$P(^(0),"^",4),1:"")
29 Q
30 ;
31RGY ;
32 F DFN=0:0 S DFN=$O(^PS(55,PSIVGL1,PSIVSN,PSIVGL2,PSIVT,PSIV1,PSIV2,DFN)) Q:'DFN D ENIV^PSJAC F ON=0:0 S ON=$O(^PS(55,PSIVGL1,PSIVSN,PSIVGL2,PSIVT,PSIV1,PSIV2,DFN,ON)) Q:'ON D SETP,PRNTO
33 Q
34SETP S Y=^PS(55,DFN,"IV",ON,0) F X=1:1:23 S P(X)=$P(Y,"^",X)
35 Q
36WD X ^DD("DD") W $P(Y,"@")," ",$P(Y,"@",2) Q
37HDR W:$Y @IOF W !,"MANUFACTURING LIST F" I '$D(PSIVOD) W "ROM SUSPENSE"
38 E W "OR IV ROOM: ",$P(^PS(59.5,PSIVSN,0),U)," AT " S Y=PSIVDT X ^DD("DD") W $P(Y,"@")
39 W !,"Printed on",?30,": "
40 D NOW^%DTC S Y=$E(%,1,12) K %I,%H,%
41 D WD G:'$D(PSIVOD) HDRE
42 S X=$$CODES^PSIVUTL(PSIVT,55.01,.04) W !,X," manufacturing time: " S Y=PSIVMT(PSIVT) D WD W !!,X,"S covering from " S Y=PSIVOD(PSIVT) D WD W " to " S Y=PSIVCD(PSIVT) D WD
43 I NOFLG=1 W ! D DESC^PSIVLBL1(PSIVT)
44 Q:NOFLG=1 W !!?20,"Order",?60,"Totals",?80,"Lot #'s"
45HDRE W ! F X=1:1:IOM-1 W "-"
46 W ! S X=$$CODES^PSIVUTL(PSIVT,55.01,.04) W:X]"" !,"*** ",X,"S ***",!
47 Q
48RGY1 W !,PSIVDN,?55,"Total: ",^PS(55,PSIVGL1,PSIVSN,PSIVGL2,PSIVT,PSIV1,0) W:$E(PSIVDN,1,3)="***" !?16,PSIVDN
49 S PSIV2="" F JJ=0:0 S PSIV2=$O(^PS(55,PSIVGL1,PSIVSN,PSIVGL2,PSIVT,PSIV1,PSIV2)) Q:PSIV2="" S PSIVDN=PSIV2 D:PSIVDN["^"!(PSIVDN["zz") LOOKUP D RGY
50 ;
51 Q
52TOTAL W !?60,"_______",!?47,"Overall Total: ",TOTAL S TOTAL=0 Q
Note: See TracBrowser for help on using the repository browser.