source: WorldVistAEHR/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSJORP2.m@ 1766

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

initial load of WorldVistAEHR

File size: 4.1 KB
Line 
1PSJORP2 ;BIR/JCH-CALCULATE FIRST DOSE FOR OE/RR 3.0 ;27 Feb 03 / 9:40 AM
2 ;;5.0; INPATIENT MEDICATIONS ;**80,110,111,133,189**;16 DEC 97;Build 4
3 ;
4 Q
5ENQ(PSGP,INFO) ; start
6 ; INFO (piece 1) = START DATE/TIME
7 ; INFO (piece 2) = STOP DATE/TIME
8 ; INFO (piece 3) = SCHEDULE
9 ; INFO (piece 4) = SCHEDULE TYPE
10 ; INFO (piece 5) = ORDERABLE ITEM
11 ; INFO (piece 6) = ADMIN TIMES
12 ;
13 N PSGNESD,PSGSD,PSGNEFD,PSGFD,PSGSCH,PSGST,PST,PSGS0XT,PSGS0Y,PSGED,SCHFREQ,FIRST,PSGDF,PSGS
14 S (PSGSD,PSGNESD)=$P(INFO,U),(PSGFD,PSGNEFD)=$P(INFO,U,2),PSGSCH=$P(INFO,U,3),(PSGST,PST)=$P(INFO,U,4),PSGS0Y=$P(INFO,U,6)
15 S PSGST=$S(PSGST="O":"O",1:"C"),PSGS0XT="",FIRST=""
16 Q:'PSGSD "" S X=PSGSCH D ADMIN^PSJORPOE
17 I ($P(INFO,"^",6)]""),($G(PSGS0Y)'=$P(INFO,"^",6)) S PSGS0Y=$P(INFO,"^",6)
18 I $G(PSJLSTAT),'$G(PSGS0XT),'$$DOW^PSIVUTL(PSGSCH) D
19 .N D,DA,X,PSGAT,PSGOES,PSGST,PSJNSS,PSJPWD,TEST,VALMBCK,PSGS0Y,PSGDT S X=$P(INFO,"^",3) I X]"" S PSGOES=1 D EN^PSGORS0
20 I '$G(PSJLSTAT) S X2=$S(PSGS0XT>1440:(PSGS0XT\1440)+1,1:7),X1=PSGSD D C^%DTC S (PSGFD,PSGNEFD)=X
21 I 'PSGS0Y S:PSGSCH["@" PSGS0Y=$P(PSGSCH,"@",2) I 'PSGS0Y S PSGS0Y=$P(PSGSD,".",2) I $G(PSGST)'="O",($E(PSGS0Y,1,2)<23),($P($G(PSJSYSW0),"^",5)=1) D
22 . I $L($P(PSGSD,".",2))<3 S DCAL=$P(PSGSD,".",2) Q
23 . N DCAL S DCAL=$E($$FMADD^XLFDT(PSGSD,0,1,0,0),9,10) S:DCAL PSGS0Y=DCAL
24 S PSGS=$S(PSGST="C":1,PSGST="P":2,PSGST="O":4,1:"")
25 S X2=PSGNESD,X1=PSGNEFD D ^%DTC S PSGDF=X+30
26 K PSGD S X=$P(PSGSD,"."),PSGDW="" F Q=0:1:PSGDF-1 S X1=$P(PSGSD,"."),X2=Q D:Q C^%DTC S PSGD(X)=$E(X,4,5)_"/"_$E(X,6,7),HX=X D DW^%DTC S $P(PSGD(HX),U,2)=X
27 D NOW^%DTC S PSGDT=%
28 S PST=PSGST,PSGED=PSGSD D OS(PSGP,PSGST)
29 I $D(PSGD)<10 Q ""
30 D PRT(X) I $G(PSJLSTAT) S:$G(LAST)>PSGFD LAST=PSGFD Q +$G(LAST)
31 I $G(FIRST)<PSGSD S FIRST=PSGSD
32 I $P(PSGSD,".")=$P(FIRST,"."),($P($G(^PS(59.6,+$G(PSJPWD),0)),"^",5)=2),'$G(PSGS0Y) S FIRST=PSGSD
33 K PSGD,TS,PSGGD,X,S,Q,QQ,QST
34 Q FIRST
35 ;
36OS(PSGP,PSGST) ; order record set
37 S SD=PSGNESD I $S($P(SD,".")>PSGNEFD:1,PSGS=1:PSGSCH["PRN",1:0) Q
38 S FD=PSGNEFD,T=PSGS0XT
39 S QST=$S(PST="C"!(PST="O"):PST,PST="OC":"OA",PST="P":"OP",PSGSCH["PRN":"OR",1:"CR")
40 S QQ="" I QST["C" D DTS(PSGSCH) S SD=$P(SD,"."),QQ="" F X=0:0 S X=$O(PSGD(X)) Q:'X D
41 . S QQ=QQ_$S(X<SD:"",X>FD:"",'S:$P(PSGD(X),U),$D(S(X)):$P(PSGD(X),U),1:"")
42 I PSGS0XT="D",PSGS0Y="" S PSGS0Y=$P(PSGNESD,".",2)
43 S X=$S(QST["C"!(QST="O"):PSGS0Y,1:"")_U_QQ
44 Q
45 ;
46DTS(SCHEDULE) ;
47 K S S S=0 I SCHEDULE["@"!(PSGST="D") S WD=$S(SCHEDULE["@":$P(SCHEDULE,"@"),1:SCHEDULE) D
48 . F Q=0:0 S Q=$O(PSGD(Q)) Q:'Q F QQ=1:1:$L(WD,"-") I $P($P(PSGD(Q),U,2),$P(WD,"-",QQ))="" S S(Q)="",S=S+1 Q
49 Q:SCHEDULE["@"!(T="D") Q:T'>1440 S WD=$P(PSGSD,".") I '(T#1440) S (SD,X)=$P(SD,"."),PSGT=T\1440 D
50 . F QQ=0:1 S X1=SD,X2=QQ*PSGT D:X2 C^%DTC I X'<WD S S=S+1 Q:X>PSGFD Q:X>FD S S(X)=""
51 K PSGT Q:'(T#1440) S PSGT=T,X1=PSGSD,(ST,X2)=SD I PSGSD>SD D ^%DTC I X>1 S ST=$$EN^PSGCT(SD,X-1*1440\T*T)
52 S (PSGS,X)=ST F PSGX=0:1 S AM=PSGT*PSGX,ST=PSGS S:AM X=$$EN^PSGCT(ST,AM) S X=$P(X,".") I X'<WD Q:X>PSGFD Q:X>FD I '$D(S(X)) S S=S+1,S(X)=""
53 K AM,ST,PSGS,PSGT,PSGX Q
54 ;
55PRT(PSGTS) ; order info
56 S PSGGD=$P(PSGTS,"^",2),PSGTS=$P(PSGTS,"^") S PSJPSTO=PST
57 D TS(PSGTS) D FIRST D:$G(PSJLSTAT) LAST
58 S PSGOC=$G(PSGOC)+1
59 Q
60 ;
61FIRST ; find expected first dose
62 N QTS,ADMIN S FIRST=""
63 I PST["CZ" NEW PSGLFFD,PSGGD S P(9)="",PSGLFFD="9999999",PSGGD="" Q
64 I TS=1,'PSGTS Q
65 F Q=0:0 S Q=$O(PSGD(Q)) Q:'Q!$G(FIRST) S ADMIN=0 F S ADMIN=$O(TS(ADMIN)) Q:'ADMIN!$G(FIRST) D
66 . S QTS=Q_"."_TS(ADMIN)
67 . S FIRST=$S(QTS<PSGSD:"",QTS'<PSGFD:"",PSGGD="":"",PSGGD[$P(PSGD(Q),"^"):QTS,1:"")
68 Q
69 ;
70LAST ; find expected last dose
71 N QTS,ADMIN S LAST=""
72 I PST["CZ" NEW PSGLFFD,PSGGD S P(9)="",PSGLFFD="9999999",PSGGD="" Q
73 I TS=1,'PSGTS Q
74 S Q=99999999 F S Q=$O(PSGD(Q),-1) Q:'Q!$G(LAST) S ADMIN="" F S ADMIN=$O(TS(ADMIN),-1) Q:'ADMIN!$G(LAST) D
75 . S QTS=Q_"."_TS(ADMIN)
76 . S LAST=$S(QTS>PSGFD:"",QTS'>PSGSD:"",PSGGD="":"",PSGGD[$P(PSGD(Q),"^"):QTS,1:"")
77 Q
78 ;
79TS(X) ;
80 K TS S TS=$L(X,"-") F Q=1:1:TS S TS(Q)=$P(X,"-",Q)
81 Q
82 ;
83LASTAT(PSGP,INFO) ;
84 N LSTDT,PSJLSTAT S LASTAT=0,PSJLSTAT=1 S LASTAT=$$ENQ(PSGP,INFO)
85 I (LASTAT>$P(INFO,"^",2)!'LASTAT) S LASTAT=$P(INFO,"^",2)
86 K PSGD,TS,PSGGD,X,S,Q,QQ,QST
87 Q LASTAT
Note: See TracBrowser for help on using the repository browser.