source: WorldVistAEHR/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSIVQUI.m@ 861

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

initial load of WorldVistAEHR
File size: 4.3 KB
Line 
1PSIVQUI ;BIR/RGY,MLM-HANDLE QUICK CODE ENTRIES ;15 Dec 98 / 8:29 AM
2 ;;5.0; INPATIENT MEDICATIONS ;**21,50,65,73,76,93,104,110**;16 DEC 97
3 ;
4 ;Reference to ^PS(51.1 is supported by DBIA 2177
5 ;Reference to ^PS(51.2 is supported by DBIA 2178
6 ;Reference to ^PS(52.6 is supported by DBIA 1231
7 ;Reference to ^PS(52.7 is supported by DBIA 2173
8 ;
9 N X,PSIVSC1 S (PSIVAT,PSIVAAT,PSIVWAT)="",PSIVQUIY=Y,(X,PSIVQUIX)=PSIVX
10 Q:'Y!(PSIVQUIX="") S PSIVX0=$O(^PS(52.6,"C",X,+Y,0)),PSIVX0=$G(^PS(52.6,+Y,1,PSIVX0,0))
11 I $P(PSIVX0,"^",5)]""!$P(PSIVX0,"^",6)!(P(5)) S PSIVAAT=$P(PSIVX0,"^",6)
12 K PSIVX0 S Y=PSIVQUIY,Y(0)=$G(^PS(52.6,+Y,0)),X=PSIVQUIX
13 Q:$S('$D(X):1,'$D(^PS(52.6,"C",X)):1,1:0)!'$D(P(4))
14SET K DRG S PSIVX0=$S($D(^PS(52.6,+Y,1,+$O(^PS(52.6,"C",X,+Y,0)),0)):^(0),1:""),(DRGI,DRG("AD",0))=1,TDRG("AD",+Y,DRGI)="",DRG("AD",DRGI)=+Y_U_$P(Y(0),U)_U_$P(PSIVX0,"^",2)_U_U_$P(Y(0),U,13)_U_$P(Y(0),U,11)
15 N PSIVQZ,PSIVADD0,PSIVSZ,PSIVAZ,PSIVXAT,PSIVSIEN,PSIVXW S PSIVSIEN=0
16 I $P(PSIVX0,U,4)]"" S P("OPI")=$P(PSIVX0,U,4)
17 I $P(PSIVX0,U,7)?1N.N D Q:$G(PSGORQF)
18 . S ND=$G(^PS(52.7,$P(PSIVX0,U,7),0))
19 . W !!,"SOLUTION: ",$P(ND,U),!
20 . N FIL S FIL="52.7",DRGTMP=$P(PSIVX0,U,7) D ORDERCHK^PSIVEDRG(DFN,ON55,1)
21 . I $G(PSGORQF) S X="^",DONE=1 Q
22 . S DRG("SOL",0)=1,DRG("SOL",1)=$P(PSIVX0,U,7)_U_$P(ND,U)_U_$P(ND,U,3)_U_U_$P(ND,U,13)_U_$P(ND,U,11),TDRG("SOL",$P(PSIVX0,U,7),1)=""
23 I $P(PSIVX0,U,5)]""!P(5) S X=$P(PSIVX0,U,5)
24 S PSIVQZ=$P(PSIVX0,U,5),PSIVQAZ=$P(PSIVX0,U,6),PSIVADD0=$G(^PS(52.6,+PSIVQUIY,0)),X=PSIVQZ
25 S PSIVSZ=$P(PSIVADD0,"^",5),PSIVAZ=$P(PSIVADD0,"^",6)
26 S PSIVAAT=$S(PSIVQZ]""&(PSIVQAZ]""):PSIVQAZ,PSIVQZ=""&(PSIVSZ]""):PSIVAZ,PSIVQZ=PSIVSZ:PSIVAZ,1:"")
27 I $P(PSIVX0,U,5)']""!P(5) S X=$S(X]"":X,1:$P($G(^PS(52.6,+PSIVQUIY,0)),"^",5))
28 ;
29 ; If a sched was found, check all matching schedules
30 ; in 51.1 against $P(PSIVX0,"^",5), PSIVAAT, PSIVWAT
31 I PSIVQZ]"",$G(X)'="" S ZZ=0 D
32 .;if ZZ sched/times matches quick code sched/times, use the schedule
33 .F S ZZ=$O(^PS(51.1,"AC","PSJ",X,ZZ)) Q:'ZZ!PSIVSIEN D Q:PSIVSIEN
34 ..N PSIVXAT S PSIVXAT=$P(^PS(51.1,ZZ,0),"^",2) Q:PSIVXAT=""
35 ..I PSIVXAT=$P(PSIVX0,"^",6) S PSIVAT=$P(PSIVX0,"^",6),PSIVSIEN=ZZ
36 ;
37 ; If quick code has no schedule, check IV additive
38 I PSIVAT="",$P(PSIVX0,"^",5)="",$G(X)'="" S ZZ=0 D
39 .F S ZZ=$O(^PS(51.1,"AC","PSJ",X,ZZ)) Q:'ZZ!PSIVSIEN D Q:PSIVSIEN
40 ..N PSIVXAT S PSIVXAT=$P(^PS(51.1,ZZ,0),"^",2) Q:PSIVXAT=""
41 ..I PSIVAAT=PSIVXAT,(X=PSIVSZ) S PSIVAT=PSIVAAT,PSIVSIEN=ZZ
42 .I PSIVAT="",PSIVAAT]"" S PSIVAT=PSIVAAT,$P(PSIVX0,"^",6)=PSIVAAT,$P(PSIVX0,"^",5)=PSIVSZ,PSIVSIEN=-1
43 ;
44 ; If quick code has schedule, no admin times, use ward times
45 I PSIVAT="",PSIVQZ]"",$G(X)'="" D
46 .S PSIVXW=$S($G(WSCHADM):WSCHADM,$G(VAIN(4)):+VAIN(4),1:"") Q:'PSIVXW
47 .S ZZ=0 F S ZZ=$O(^PS(51.1,"AC","PSJ",X,ZZ)) Q:'ZZ!PSIVSIEN D Q:PSIVSIEN
48 ..N PSIVXAT S PSIVXAT=$P(^PS(51.1,ZZ,0),"^",2) Q:PSIVXAT=""
49 ..S PSIVWAT=$P($G(^PS(51.1,ZZ,1,+PSIVXW,0)),"^",2)
50 ..I PSIVWAT]"" S PSIVAT=PSIVWAT,PSIVSIEN=ZZ
51 ;
52 ; No ward times; go back to IV additive. If quick code has schedule,
53 ; make sure it matches IV additive
54 I PSIVAT="",PSIVAAT]"",PSIVWAT="",$G(X) D
55 .S ZZ=0 F S ZZ=$O(^PS(51.1,"AC","PSJ",X,ZZ)) Q:'ZZ!PSIVSIEN D Q:PSIVSIEN
56 ..N PSIVXAT S PSIVXAT=$P(^PS(51.1,ZZ,0),"^",2) Q:PSIVXAT=""
57 ..I (PSIVQZ=X&(PSIVQZ=PSIVSZ))!(PSIVQZ=""&(PSIVSZ]"")) I PSIVXAT=PSIVAAT D Q
58 ...S PSIVAT=PSIVAAT,PSIVSIEN=ZZ
59 .I PSIVAT="" S PSIVAT=PSIVAAT,$P(PSIVX0,"^",6)=PSIVAAT,$P(PSIVX0,"^",5)=X,PSIVSIEN=-1
60 I $G(PSIVSIEN) S Y=$S(PSIVSIEN>0:PSIVSIEN,1:"") N PSGOES S PSGOES=1
61 I X="" S (Y,PSIVQUIY)=""
62 S PSIVSPQF=1 D EN^PSIVSP K PSIVSPQF
63 S P(11)=$S($P(PSIVX0,"^",6)]"":$P(PSIVX0,"^",6),(PSIVQZ]""&(PSIVWAT]"")):PSIVWAT,PSIVAAT]"":PSIVAAT,$G(P(11))]"":$G(P(11)),1:PSIVAT)
64 S X=$P(PSIVX0,"^",3)
65 I $P(PSIVX0,U,8) D
66 .S P("MR")=+$P(PSIVX0,U,8)_U_$S($P($G(^PS(51.2,+$P(PSIVX0,U,8),0)),U,3):$P($G(^PS(51.2,+$P(PSIVX0,U,8),0)),U,3),1:$E($P($G(^PS(51.2,+$P(PSIVX0,U,8),0)),U),1,5))
67 W " ",X D ENI^PSIVSP I '$D(X) W $C(7)," --> Invalid infusion rate !!" I '$$SCHREQ^PSJLIVFD(.P) S P(15)=0
68 I $$SCHREQ^PSJLIVFD(.P),'$$DOW^PSIVUTL($G(P(9))),'(P(15)>0) S P(15)=$$INTERVAL^PSIVUTL(.P)
69 S PSIVOK="57^58^59^3^26^39^63^64^"_$S($E(P("OT"))="I":"101^109^",1:"")_"10^25^1"
70 S P(17)="A",P(8)=$S($D(X):X,1:""),PSIVE=0,PSIVSTR="QUICK CODE",(DRG(2),Y)="",EDIT=$S(+P("MR"):"",1:"3^")_$P(EDIT,"64^",2) K ND,PSIVX0,PSIVSC,PSIVX
71 Q
Note: See TracBrowser for help on using the repository browser.