source: FOIAVistA/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSJEEU0.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 4.0 KB
Line 
1PSJEEU0 ;BIR/CML3,PR-MORE EXTERNAL ENTRIES ;22 OCT 97 / 10:22 AM
2 ;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97
3 ;
4ENHS ;
5 S PSGP=DFN,PSJACNWP=1 D ENIV^PSJAC,NOW^%DTC K ^UTILITY("PSG",$J),^UTILITY("PSIV",$J) S X=$S('$G(PSJEDT):%,$P(PSJEDT,".",2):PSJEDT-.0001,1:PSJEDT)
6 F X=X:0 S X=$O(^PS(55,PSGP,5,"AUS",X)) Q:'X F Y=0:0 S Y=$O(^PS(55,PSGP,5,"AUS",X,Y)) Q:'Y S X(0)=$G(^PS(55,PSGP,5,Y,0)) S PSJROOT="^PS(55,"_PSGP_",5,"_Y_"," D UDSET
7 F Y=0:0 S Y=$O(^PS(53.1,"AC",PSGP,Y)) Q:'Y S X(0)=$G(^PS(53.1,Y,0)) I "PU"'[$P(X(0),"^",9) S PSJROOT="^PS(53.1,"_Y_"," D UDSET
8 ;
9ENHSI ;Build all IV Active/Non-verified orders
10 D ENNA^PSIVACT F ON=0:0 S ON=$O(^PS(55,DFN,"IV",ON)) Q:'ON I $D(^(ON,0)) S Y=^(0) I $S("ANROH"[$P(Y,U,17):1,'$G(PSJEDT):0,1:$P(Y,U,3)'<$G(PSJEDT)) F I=1:1:23 S P(I)=$P(Y,U,I) I I=23 D 0
11 ;
12DONE ;
13 N DFN D ENKV^PSGSETU K V,X,Y,Z,P,S,A,NUM,PS,PSJACNWP,ON,PSIVREA
14 K PSJROOT,PSJTEXT,PSJFNM,PSJUD Q
15 ;
160 ;Build 0 node
17 S P(17)=$S("AROH"[P(17):"A;ACTIVE",P(17)="D":"D;DISCONTINUED",P(17)="E":"E;EXPIRED",1:"N;NON VERIFIED")
18 S X=$P($G(^VA(200,+P(6),0)),U),P(6)=P(6)_":VA(200,;"_X
19 S P(10)=P(2) F Z=P(2):-.000001 I '$D(^UTILITY("PSIV",$J,-Z)) S P(2)=Z Q
20 S ^UTILITY("PSIV",$J,-P(2),0)=P(10)_U_P(3)_U_P(6)_U_P(17)_U_P(8)_U_P(9)
21 S NUM=0 F A=0:0 S A=$O(^PS(55,DFN,"IV",ON,"AD",A)) Q:'A I $D(^(A,0)) S P=^(0),NUM=NUM+1,^UTILITY("PSIV",$J,-P(2),"A",NUM)=$P(P,U)_";"_$P($G(^PS(52.6,$P(P,U),0)),U)_U_$P(P,U,2)
22 S NUM=0 F S=0:0 S S=$O(^PS(55,DFN,"IV",ON,"SOL",S)) Q:'S I $D(^(S,0)) S P=^(0),NUM=NUM+1,^UTILITY("PSIV",$J,-P(2),"S",NUM)=$P(P,U)_";"_$P($G(^PS(52.7,$P(P,U),0)),U)_U_$P(P,U,2)
23 Q
24 ;
25UDSET ;
26 ; changed line below to look at .2 node for Orderable Item.
27 K PSJUD,PSJFNM
28 ;S X(2)=$G(^(2)),X(1)=$G(^(.2)),V=$P(X(2),"^",2)_"^"_$P(X(2),"^",4)_"^"_$P(X(1),"^")_":PS(50.3,;"_$$ENPDN^PSGMI($P(X(1),"^"))_"^"_+$P(X(0),"^",2)_":VA(200,;"_$$ENNPN^PSGMI(+$P(X(0),"^",2))_"^"
29 S X(2)=$G(^(2)),X(1)=$G(^(.2)),V=$P(X(2),"^",2)_"^"_$P(X(2),"^",4)_"^"_$$GETDRUG_"^"_+$P(X(0),"^",2)_":VA(200,;"_$$ENNPN^PSGMI(+$P(X(0),"^",2))_"^"
30 S V=V_$P(X(0),"^",9)_";"_$P("ACTIVE^NON-VERIFIED^DISCONTINUED^INCOMPLETE^EXPIRED^HOLD^RENEWAL","^",$F("ANDIEHR",$P(X(0),"^",9))-1)
31 ;S Z=$G(^PS(51.2,+$P(X(0),"^",3),0)),V=V_"^"_$P(X(1),"^",2)_"^"_$P(X(0),"^",3)_":PS(51.2,;"_$P(Z,"^",3)_";"_$P(Z,"^")
32 S Z=$G(^PS(51.2,+$P(X(0),"^",3),0)),V=V_"^"_$$GETAMT_"^"_$P(X(0),"^",3)_":PS(51.2,;"_$P(Z,"^",3)_";"_$P(Z,"^")
33 S Z=$P(X(0),"^",7),V=V_"^"_$P(X(2),"^")_"^"_Z_";"_$S(Z="C":"CONTINUOUS",Z="O":"ONE TIME",Z="OC":"ON CALL",Z="P":"PRN",Z="R":"FILL ON REQUEST",1:"") F Z=-$P(X(2),"^",2):-.00001 I '$D(^UTILITY("PSG",$J,Z)) S ^(Z)=V Q
34 Q
35 ;
36ENIVSE ; IV schedule edit
37 S PSJPP="PSJ" F FQ=0:0 K DA,DIC,DR S DIC="^PS(51.1,",DIC(0)="AELSQ",DIC("DR")="4////PSJ;5////C",DIC("S")="I ""C""[$P(^(0),""^"",5)",D="APPSJ" W ! D IX^DIC Q:Y'>0 S DA=+Y,DIE=DIC,DR="[PSJI SCHEDULE EDIT]" K DIC D ^DIE
38 K C,D0,D1,FQ,PSJIVSEF,PSJPP,Z D ENIVKV^PSGSETU
39 Q
40GETDRUG() ; get orderable item or dispense drug
41 I '$$DISPCNT&'$D(@(PSJROOT_".2)")) Q $$PRIMARY
42 I $$DISPCNT&'$P($G(@(PSJROOT_".2)")),"^",2) Q $$DISPDISP
43 E S PSJFNM=$P($G(@(PSJROOT_".2)")),"^")
44 Q PSJFNM_":PS(50.7,;"_$$ENPDN^PSGMI($P(X(1),"^"))_" "_$P($G(^PS(50.606,$P($G(^PS(50.7,PSJFNM,0)),"^",2),0)),"^")
45DISPCNT() ; returns 1 if only only one dispense drug, 0 if more than one
46 N CNT,LOOP S (CNT,LOOP)=0 F S LOOP=$O(@(PSJROOT_"1,"_LOOP_")")) Q:'LOOP D
47 .S CNT=CNT+1
48 I CNT>1 S CNT=0
49 Q CNT
50DISPDISP() ; return Dispense drug name
51 N LOOP
52 S LOOP=0 F S LOOP=$O(@(PSJROOT_"1,"_LOOP_")")) Q:'LOOP D
53 .S PSJTEXT=$P($G(^PSDRUG($P($G(@(PSJROOT_"1,LOOP,0)")),"^"),0)),"^")
54 .S PSJFNM=$P($G(@(PSJROOT_"1,LOOP,0)")),"^")
55 .S PSJUD=$P($G(@(PSJROOT_"1,LOOP,0)")),"^",2)
56 .I PSJUD="" S PSJUD=1
57 Q PSJFNM_":PSDRUG(;"_PSJTEXT
58GETAMT() ; get dosage ordered or units per dose
59 Q $S($D(PSJUD):PSJUD,1:$P(X(1),"^",2))
60PRIMARY() ; return Primary drug, order has no Orderable Item node
61 S PSJTEXT=$P($G(^PS(50.3,+$P($G(@(PSJROOT_".1)")),"^"),0)),"^")
62 S PSJFNM=$P($G(@(PSJROOT_".1)")),"^")
63 S PSJUD=$P($G(@(PSJROOT_".1)")),"^",2)
64 Q PSJFNM_":PS(50.3;"_$S($L(PSJTEXT):PSJTEXT,1:"DRUG NOT FOUND")
Note: See TracBrowser for help on using the repository browser.