source: WorldVistAEHR/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSJMIV.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.7 KB
Line 
1PSJMIV ;BIR/MV-IV ORDER FOR MED DUE WORKSHEET. ;20 DEC 96 / 3:12 PM
2 ;;5.0; INPATIENT MEDICATIONS ;**58,116**;16 DEC 97
3 ;
4 ; Reference to ^PS(55 is supported by DBIA 2191.
5 ;
6START ;*** Read IV orders
7 NEW P S ON=""
8 F PSGEXPDT=PSGPLS-.0001:0 S PSGEXPDT=$O(^PS(55,PSGP,"IV","AIT",PST,PSGEXPDT)) Q:'PSGEXPDT F S ON=$O(^PS(55,PSGP,"IV","AIT",PST,PSGEXPDT,ON)) Q:ON="" D IV
9 Q
10IV ;*** Process IV order based on schedule and interval
11 K ADM N X,ON55,PSJLABEL S DFN=PSGP,PSJLABEL=1 D GT55^PSIVORFB
12 Q:"DE"[P(17)
13 Q:P(2)>PSGPLF
14 S X=$P(P("MR"),U,2) Q:XTYPE=2&(X["IV") Q:XTYPE=3&(PST="S")&'($S(X="IV":1,X="IVPB":1,1:0))
15 S QST=$$ONE^PSJBCMA(PSGP,ON,P(9),P(2),P(3))
16 S QST=$S(P(9)["PRN":"OVP",QST="O":"OVO",1:"CV")_XTYPE
17 I P(9)]"" D SCHEDULE Q
18 S PSGON=0 D:P(15) INTERVAL
19 Q
20INTERVAL ;*** Calculate admin time by schedule interval.
21 NEW MN,ND,ND1,PLSD,PSGPLC,ST,T,TS
22 K PSGMAR
23 F I=0:1 S ADM=$$FMADD^XLFDT(P(2),0,0,P(15)*I,0) Q:ADM>$S(P(3)<PSGPLF:P(3),1:PSGPLF) S:ADM'<PSGPLS PSGMAR(ADM)=""
24 S ON=ON_"*" D IVTMP ;*** ON_"*" =projected time for cont. IV.
25 Q
26SCHEDULE ;*** Calculate admin times for IV that has schedule defined.
27 K PSGMAR S PSGPLC=0 S PSGOES=1,X=P(9) D EN^PSGS0 S T=PSGS0XT,PSGOES=""
28 S ND1=P(4),ST=P(2),PLSD=P(3),TS=P(11),MN=T,ND=P(9) I $S(ST'?7N1"."1N.E:1,1:PLSD'?7N1"."1N.E) S PSGPLC="OI" Q
29 D ENIV^PSJPL0
30 D IVTMP
31 Q
32IVTMP ;*** Set IV ^TMP.
33 I DRG S X=$S($G(DRG("AD",1)):DRG("AD",1),1:$G(DRG("SOL",1))),DRG=$E($$ENPDN^PSGMI($P(X,U,6)),1,20)_U_ON
34 F ADMIN=0:0 S ADMIN=$O(PSGMAR(ADMIN)) Q:'ADMIN S PSJADT=$P(ADMIN,"."),PSJATME=+$E($P(ADMIN,".",2)_"0000",1,4) D @PSGSS
35 Q
36P ;*** Set ^TMP when select by patient
37 S ^TMP($J,PSJADT,PPN_U_PSGP,PSJATME,QST,DRG)=PSGP_U_ON_U_PSJPPID_U_PSJPWDN_U_PSJPRB
38 Q
39G ;*** Goto W to set ^TMP when selected by WARD/WARD GROUP
40 ;
41W ;
42 S:PSGRBADM="A" ^TMP($J,PSJADT,TM,PSJATME,PSJPRB,PPN,QST,DRG)=PSGP_U_ON_U_PSJPPID_U_PSGWN_U_PSJPRB
43 S:PSGRBADM="R" ^TMP($J,PSJADT,TM,PSJPRB,PPN,PSJATME,QST,DRG)=PSGP_U_ON_U_PSJPPID_U_PSGWN_U_PSJPRB
44 S:PSGRBADM="P" ^TMP($J,PSJADT,TM,PPN_U_PSGP,PSJATME,QST,DRG)=PSGP_U_ON_U_PSJPPID_U_PSGWN_U_PSJPRB
45 Q
46 ;
47 ;
48PRT ;*** Print IV orders for Med Due Worksheet.
49 N ON55,DRG,P,PSJLABEL S DFN=PSGP,PSJLABEL=1
50 D:QST'["Z" GT55^PSIVORFB
51 ;* I QST["Z" D GT531^PSIVORFA(DFN,ON) S P("OPI")=^TMP($J,QST,PSGP,ON,1)
52 I QST["Z" D GT531^PSIVORFA(DFN,ON),SI^PSJMPEND S P("OPI")=PSJSI
53 F X="LOG",2,3 S:P(X) P(X)=$$ENDTC^PSGMI(P(X))
54 S PSJONETM=$S(QST="OVO":1,1:0)
55 S PSJSI=$P(P("OPI"),"^")
56 NEW NEED S PSJNEED=0
57 F X="AD","SOL" D NAMENEED^PSJMUTL(X,40,.NEED) S PSJNEED=PSJNEED+NEED
58 S X=$L($P(P("OPI"),"^"))/41,X=$P(X,".")+($P(X,".",2)>0)+(P(4)="C")
59 S:$D(DRG("AD",0))&$D(DRG("SOL",0)) X=X+1
60 S PSJNEED=PSJNEED+X+4+PSJONETM
61 D ^PSJMPRTU
62 D:(PSJNEED+PSJLN)>PSJTOTLN HDR^PSJMPRTU Q:$G(PSJSTOP)
63 D PRTIV
64 Q
65 ;
66PRTIV ;
67 ;* W !,PSJPRT(1),?39,$E(P("LOG"),1,5)," | ",$E(P(2),1,5),$E(P(2),9,15)," | ",P(3)
68 W !,PSJPRT(1),?39,$E(P("LOG"),1,5)," | "
69 I QST["Z" W "P E N D I N G"
70 E W $E(P(2),1,5),$E(P(2),9,15)," | ",P(3)
71 NEW X,Y
72 F X=0:0 S X=$O(DRG("AD",X)) Q:'X D NAME^PSIVUTL(DRG("AD",X),40,.NAME,1) F Y=0:0 S Y=$O(NAME(Y)) Q:'Y D ADSOL W NAME(Y)
73 I $G(DRG("SOL",1)) D ADSOL W " in"
74 F X=0:0 S X=$O(DRG("SOL",X)) Q:'X D NAME^PSIVUTL(DRG("SOL",X),40,.NAME,0) F Y=0:0 S Y=$O(NAME(Y)) Q:'Y D ADSOL W NAME(Y)
75 S:ON["*" PSJASTR=1
76 W !?39,$P(P("MR"),U,2)," ",P(9)," ",P(8)
77 W:PSJONETM !?39,"*** ONE TIME ***"
78 W:P(4)="C" !?39,"*CAUTION-CHEMOTHERAPY*"
79 I PSJSI]"" W !?39 F Y=1:1:$L(PSJSI," ") S Y1=$P(PSJSI," ",Y) W:($L(Y1)+$X)>79 !?39 W Y1_" "
80 W !?39,"RN/LPN Init: ________"
81 W !
82 S PSJLN=PSJLN+PSJNEED
83 Q
84ADSOL ;
85 I PSJLN>PSJTOTLN W !?39,"*** CONTINUE ON NEXT PAGE ***" NEW X D ^PSJMPRTU,HDR^PSJMPRTU D
86 .W !,PSJPRT(1),?39,$E(P("LOG"),1,5)," | ",$E(P(2),1,5),$E(P(2),9,15)," | ",P(3)
87 S PSJLN=PSJLN+1,PSJNEED=PSJNEED-1
88 S I=$O(PSJPRT(1)) W !,$G(PSJPRT(+I)),?39
89 K:I PSJPRT(I)
90 Q
Note: See TracBrowser for help on using the repository browser.