source: FOIAVistA/trunk/r/PHARMACY_DATA_MANAGEMENT-PSS/PSSDDUT3.m@ 1590

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

initial load of FOIAVistA 6/30/08 version

File size: 5.2 KB
Line 
1PSSDDUT3 ;BIR/LDT-Pharmacy Data Management DD Utility ; 09/17/97 14:35
2 ;;1.0;PHARMACY DATA MANAGEMENT;**35**;9/30/97
3 ;
4 ; Reference to ENSD^PSGNE3 is supported by DBIA #2150.
5 ; Reference to EN^PSGCT is supported by DBIA #2146.
6 ; Reference to ENT^PSIVWL is supported by DBIA #2154.
7 ;
8ADTM ;UNIT DOSE MULTIPLE of PHARMACY PATIENT file (55) field 41
9 S PSSHLP(1)="THE TIMES MUST BE TWO (2) OR FOUR (4) DIGITS, SEPARATED WITH"
10 S PSSHLP(2)="DASHES ('-'), AND BE IN ASCENDING ORDER. (IE. 01-05-13)"
11 D WRITE
12 Q
13 ;
14SPCIN ;UNIT DOSE MULTIPLE of PHARMACY PATIENT file (55) field 8
15 S PSSHLP(1)="IF ABBREVIATIONS ARE USED, THE TOTAL LENGTH OF THE EXPANDED"
16 S PSSHLP(2)="INSTRUCTIONS ALSO MAY NOT EXCEED 180 CHARACTERS."
17 D WRITE
18 Q
19 ;
20SCHTP ;Called from the Unit Dose Multiple of file 55, Schedule Type field 7
21 S PSSHLP(1)="CHOOSE FROM:"
22 S PSSHLP(1,"F")="!!"
23 S PSSHLP(2)="C - CONTINUOUS"
24 S PSSHLP(2,"F")="!?3"
25 S PSSHLP(3)="O - ONE-TIME"
26 S PSSHLP(3,"F")="!?3"
27 S PSSHLP(4)="OC - ON CALL"
28 S PSSHLP(4,"F")="!?3"
29 S PSSHLP(5)="P - PRN"
30 S PSSHLP(5,"F")="!?3"
31 S PSSHLP(6)="R - FILL ON REQUEST"
32 S PSSHLP(6,"F")="!?3"
33 D WRITE
34 Q
35 ;
36CHKSI ;Called from Unit Dose Multiple of file (55), Special Instructions
37 ;field 8 (Replaces ^PSGSICHK)
38 I $S(X'?.ANP:1,X["^":1,1:$L(X)>180) K X Q
39 N Y S Y="" F Y(1)=1:1:$L(X," ") S Y(2)=$P(X," ",Y(1)) I Y(2)]"" D CHK1 Q:'$D(X)
40 I $D(X),Y]"",X'=$E(Y,1,$L(Y)-1) D EN^DDIOL("EXPANDS TO:","","!?3") F Y(1)=1:1 S Y(2)=$P(Y," ",Y(1)) Q:Y(2)="" D:$L(Y(2))+$X>78 EN^DDIOL("","","!") D EN^DDIOL(Y(2)_" ","","?0")
41 K Y Q
42CHK1 ;
43 I $L(Y(2))<31,$D(^PS(51,+$O(^PS(51,"B",Y(2),0)),0)),$P(^(0),"^",2)]"",$P(^(0),"^",4) S Y(2)=$P(^(0),"^",2)
44 I $L(Y)+$L(Y(2))>180 K X Q
45 S Y=Y_Y(2)_" " Q
46 ;
47EN2 ;Called from Unit Dose multiple of file 55, STOP DATE/TIME field 34
48 ;Replaces EN2^PSGDL
49 K PSGDLS S ND2=^PS(55,DA(1),5,DA,2) I '$P(ND2,"^",5),'$P(ND2,"^",6) G DONE
50 D EN^DDIOL(" ...Dose Limit... ","","?0")
51 ;
52ENGO ;
53 S SCH=$P(ND2,"^")
54 S ST=$S($D(PSGDLS):PSGDLS,1:$P(ND2,"^",2))
55 S TS=$P(ND2,"^",5),MN=$P(ND2,"^",6)
56 I $P(PSJSYSW0,U,5)=2 D
57 . S $P(PSJSYSW0,U,5)=1
58 . S X="PSGNE3" X ^%ZOSF("TEST") I S ST=$$ENSD^PSGNE3(ST,TS,ST,"")
59 . S $P(PSJSYSW0,U,5)=2
60 G MWF:SCH["@",DONE:'TS&'MN
61 I 'TS S X="PSGCT" X ^%ZOSF("TEST") I S AM=MN*PSGDL,X=$$EN^PSGCT(ST,AM) G DONE
62 S TM=$E(ST_"00000",9,8+$L($P(TS,"-")))
63 F Q=1:1 Q:$P(TS,"-",Q)=""!(TM<$P(TS,"-",Q))
64 S X=ST\1,C=0 F Q=Q:1 D:$P(TS,"-",Q)="" ADD S C=C+1 I C=PSGDL S X=X_"."_$P(TS,"-",Q) G DONE
65 ;
66MWF ; if schedule is similar to monday-wednesday-friday
67 S TS=$P(SCH,"@",2),SCH=$P(SCH,"@"),X=$P(ST,"."),C=0 D SCHK G:C=PSGDL DONE F Q=1:1 S X1=$P(ST,"."),X2=Q D C^%DTC S X1=X D DW^%DTC D CHK G:C=PSGDL DONE
68SCHK S X1=X D DW^%DTC F Q=1:1:$L(SCH,"-") S WKD=$P(SCH,"-",Q) I WKD=$E(X,1,$L(WKD)) Q
69 E Q
70 S TM=$E(ST_"00000",9,8+$L($P(TS,"-"))) F Q=1:1:$L(TS,"-") I TM<$P(TS,"-",Q) S C=C+1 I C=PSGDL S X=X1_"."_$P(TS,"-",Q) Q
71 Q
72CHK F QQ=1:1:$L(SCH,"-") S WKD=$P(SCH,"-",QQ) I WKD=$E(X,1,$L(WKD)) D TS Q
73 Q
74TS F Q1=1:1:$L(TS,"-") S C=C+1 I C=PSGDL S X=X1_"."_$P(TS,"-",Q1) Q
75 Q
76 ;
77DONE ;
78 K %H,%T,%Y,MN,ND2,ND4,PSGDLS,PSGDL,Q1,QQ,SCH,TM,WKD,TS,X1,X2 Q
79 ;
80ADD ;
81 S X1=$P(X,"."),X2=$S(MN&'(MN#1440):MN\1440,1:1) D C^%DTC S Q=1 Q
82 ;
83ENDL ;From DD(55.01,.03,0) Replaces call ENDL^PSIVSP
84 D EN^DDIOL(" Dose limit .... ","","?0") S PSIVMIN=P(15)*X,PSIVSD=+P(2)
85 I PSIVMIN<0 D EN^DDIOL(" --- There is something wrong with this order !!","","!!") D EN^DDIOL(" Call inpatient supervisor .....") S Y=-1 K PSIVMIN Q
86 I P(4)="P"!(P(5))!(P(23)="P"),PSIVMIN=0,"^NOW^STAT^ONCE^"'[("^"_$P(P(9)," ")_"^") D DLP G QDL
87 S X="PSIVWL" X ^%ZOSF("TEST") I D ENT^PSIVWL
88QDL I $D(X) S X=Y X ^DD("DD") W $P(Y,"@")," ",$P(Y,"@",2) S Y=X
89 Q
90DLP ;
91 S X=X+1,$P(PSIVSD,".",2)=$P(PSIVSD,".",2)_$E("0000",1,4-$L($P(PSIVSD,".",2))) D CHK3 S X2=0,Y=1 I X<2 S Y=+PSIVSD G QDLP
92 I $P(PSIVSD,".",2)>$P(P(11),"-",$L(P(11),"-")) S X2=1 G OV
93 G:$P(P(11),"-")>$P(PSIVSD,".",2) OV
94 F Y=1:1 S X1=$P(P(11),"-",Y) I X1=$P(PSIVSD,".",2)!($P(PSIVSD,".",2)<X1) Q
95OV I P(11)="" D EN^DDIOL(" ???","","$C(7)") D EN^DDIOL("*** You have not defined any administration times !!","","!?15") K X Q
96 F Y=Y:1 S:$P(P(11),"-",Y)="" X2=X2+1,Y=0,X=X+1 S X=X-1 Q:X<1
97 S X=PSIVSD\1 I X2>0 S X1=PSIVSD D C^%DTC S X=$P(X,".") ; install with version 17.3 of fileman
98 S Y=+(X_"."_$P(P(11),"-",Y))
99QDLP K X1,X2 Q
100 ;
101ENI ;^DD(555.01,.03,0)
102 K:$L(X)<1!($L(X)>30)!(X["""")!($A(X)=45) X I '$D(X)!'$D(P(4)) Q
103 I P(4)="P"!(P(5))!(P(23)="P") Q:'X S X="INFUSE OVER "_X_" MIN." D EN^DDIOL(" "_X,"","?0") Q
104 I X'=+X,($P(X,"@",2,999)'=+$P(X,"@",2,999)!(+$P(X,"@",2,999)<0)) K X Q
105 S SPSOL=$O(DRG("SOL",0)) I 'SPSOL K SPSOL,X D EN^DDIOL(" You must define at least one solution !!","","?0") Q
106 I X=+X S X=X_" ml/hr" D EN^DDIOL(" ml/hr","","?0") D SPSOL S P(15)=$S('X:0,1:SPSOL\X*60+(SPSOL#X/X*60+.5)\1) K SPSOL Q
107 S SPSOL=$P(X,"@",2) S:$P(X,"@")=+X $P(X,"@")=$P(X,"@")_" ml/hr" D EN^DDIOL(" "_+SPSOL_" Label"_$S(SPSOL'=1:"s",1:"")_" per day","","?0") D EN^DDIOL("at an infusion rate of: "_$P(X,"@"),"","!?15") S P(15)=$S('SPSOL:0,1:1440/SPSOL\1) K SPSOL
108 Q
109SPSOL S SPSOL=0 F XXX=0:0 S XXX=$O(DRG("SOL",XXX)) Q:'XXX S SPSOL=SPSOL+$P(DRG("SOL",XXX),U,3)
110 K XXX Q
111CHK3 F Y=1:1 Q:$L(P(11))>240!($P(P(11),"-",Y)="") S $P(P(11),"-",Y)=$P(P(11),"-",Y)_$E("0000",1,4-$L($P(P(11),"-",Y)))
112 Q
113 ;
114WRITE ;Calls EN^DDIOL to write text
115 D EN^DDIOL(.PSSHLP) K PSSHLP Q
116 Q
Note: See TracBrowser for help on using the repository browser.