PSJEEU0 ;BIR/CML3,PR-MORE EXTERNAL ENTRIES ;22 OCT 97 / 10:22 AM
;;5.0; INPATIENT MEDICATIONS ;**184**;16 DEC 97;Build 12
;
ENHS ;
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)
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
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
;
ENHSI ;Build all IV Active/Non-verified orders
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
;
DONE ;
N DFN D ENKV^PSGSETU K V,X,Y,Z,P,S,A,NUM,PS,PSJACNWP,ON,PSIVREA
K PSJROOT,PSJTEXT,PSJFNM,PSJUD Q
;
0 ;Build 0 node
S P(17)=$S("AROH"[P(17):"A;ACTIVE",P(17)="D":"D;DISCONTINUED",P(17)="E":"E;EXPIRED",1:"N;NON VERIFIED")
S X=$P($G(^VA(200,+P(6),0)),U),P(6)=P(6)_":VA(200,;"_X
S P(10)=P(2) F Z=P(2):-.000001 I '$D(^UTILITY("PSIV",$J,-Z)) S P(2)=Z Q
S ^UTILITY("PSIV",$J,-P(2),0)=P(10)_U_P(3)_U_P(6)_U_P(17)_U_P(8)_U_P(9)
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)
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)
Q
;
UDSET ;
; changed line below to look at .2 node for Orderable Item.
K PSJUD,PSJFNM
;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))_"^"
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))_"^"
; PSJ*5*184 Add Discontinued/Edit
S V=V_$P(X(0),"^",9)_";"_$S($P(X(0),"^",9)="DE":"DISCONTINUED/EDIT",1:$P("ACTIVE^NON-VERIFIED^DISCONTINUED^INCOMPLETE^EXPIRED^HOLD^RENEWAL","^",$F("ANDIEHR",$P(X(0),"^",9))-1))
;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,"^")
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,"^")
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
Q
;
ENIVSE ; IV schedule edit
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
K C,D0,D1,FQ,PSJIVSEF,PSJPP,Z D ENIVKV^PSGSETU
Q
GETDRUG() ; get orderable item or dispense drug
I '$$DISPCNT&'$D(@(PSJROOT_".2)")) Q $$PRIMARY
I $$DISPCNT&'$P($G(@(PSJROOT_".2)")),"^",2) Q $$DISPDISP
E S PSJFNM=$P($G(@(PSJROOT_".2)")),"^")
Q PSJFNM_":PS(50.7,;"_$$ENPDN^PSGMI($P(X(1),"^"))_" "_$P($G(^PS(50.606,$P($G(^PS(50.7,PSJFNM,0)),"^",2),0)),"^")
DISPCNT() ; returns 1 if only only one dispense drug, 0 if more than one
N CNT,LOOP S (CNT,LOOP)=0 F S LOOP=$O(@(PSJROOT_"1,"_LOOP_")")) Q:'LOOP D
.S CNT=CNT+1
I CNT>1 S CNT=0
Q CNT
DISPDISP() ; return Dispense drug name
N LOOP
S LOOP=0 F S LOOP=$O(@(PSJROOT_"1,"_LOOP_")")) Q:'LOOP D
.S PSJTEXT=$P($G(^PSDRUG($P($G(@(PSJROOT_"1,LOOP,0)")),"^"),0)),"^")
.S PSJFNM=$P($G(@(PSJROOT_"1,LOOP,0)")),"^")
.S PSJUD=$P($G(@(PSJROOT_"1,LOOP,0)")),"^",2)
.I PSJUD="" S PSJUD=1
Q PSJFNM_":PSDRUG(;"_PSJTEXT
GETAMT() ; get dosage ordered or units per dose
Q $S($D(PSJUD):PSJUD,1:$P(X(1),"^",2))
PRIMARY() ; return Primary drug, order has no Orderable Item node
S PSJTEXT=$P($G(^PS(50.3,+$P($G(@(PSJROOT_".1)")),"^"),0)),"^")
S PSJFNM=$P($G(@(PSJROOT_".1)")),"^")
S PSJUD=$P($G(@(PSJROOT_".1)")),"^",2)
Q PSJFNM_":PS(50.3;"_$S($L(PSJTEXT):PSJTEXT,1:"DRUG NOT FOUND")
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSJEEU0 4253 printed Oct 16, 2024@18:07:33 Page 2
PSJEEU0 ;BIR/CML3,PR-MORE EXTERNAL ENTRIES ;22 OCT 97 / 10:22 AM
+1 ;;5.0; INPATIENT MEDICATIONS ;**184**;16 DEC 97;Build 12
+2 ;
ENHS ;
+1 SET PSGP=DFN
SET PSJACNWP=1
DO ENIV^PSJAC
DO NOW^%DTC
KILL ^UTILITY("PSG",$JOB),^UTILITY("PSIV",$JOB)
SET X=$SELECT('$GET(PSJEDT):%,$PIECE(PSJEDT,".",2):PSJEDT-.0001,1:PSJEDT)
+2 FOR X=X:0
SET X=$ORDER(^PS(55,PSGP,5,"AUS",X))
if 'X
QUIT
FOR Y=0:0
SET Y=$ORDER(^PS(55,PSGP,5,"AUS",X,Y))
if 'Y
QUIT
SET X(0)=$GET(^PS(55,PSGP,5,Y,0))
SET PSJROOT="^PS(55,"_PSGP_",5,"_Y_","
DO UDSET
+3 FOR Y=0:0
SET Y=$ORDER(^PS(53.1,"AC",PSGP,Y))
if 'Y
QUIT
SET X(0)=$GET(^PS(53.1,Y,0))
IF "PU"'[$PIECE(X(0),"^",9)
SET PSJROOT="^PS(53.1,"_Y_","
DO UDSET
+4 ;
ENHSI ;Build all IV Active/Non-verified orders
+1 DO ENNA^PSIVACT
FOR ON=0:0
SET ON=$ORDER(^PS(55,DFN,"IV",ON))
if 'ON
QUIT
IF $DATA(^(ON,0))
SET Y=^(0)
IF $SELECT("ANROH"[$PIECE(Y,U,17):1,'$GET(PSJEDT):0,1:$PIECE(Y,U,3)'<$GET(PSJEDT))
FOR I=1:1:23
SET P(I)=$PIECE(Y,U,I)
IF I=23
DO 0
+2 ;
DONE ;
+1 NEW DFN
DO ENKV^PSGSETU
KILL V,X,Y,Z,P,S,A,NUM,PS,PSJACNWP,ON,PSIVREA
+2 KILL PSJROOT,PSJTEXT,PSJFNM,PSJUD
QUIT
+3 ;
0 ;Build 0 node
+1 SET P(17)=$SELECT("AROH"[P(17):"A;ACTIVE",P(17)="D":"D;DISCONTINUED",P(17)="E":"E;EXPIRED",1:"N;NON VERIFIED")
+2 SET X=$PIECE($GET(^VA(200,+P(6),0)),U)
SET P(6)=P(6)_":VA(200,;"_X
+3 SET P(10)=P(2)
FOR Z=P(2):-.000001
IF '$DATA(^UTILITY("PSIV",$JOB,-Z))
SET P(2)=Z
QUIT
+4 SET ^UTILITY("PSIV",$JOB,-P(2),0)=P(10)_U_P(3)_U_P(6)_U_P(17)_U_P(8)_U_P(9)
+5 SET NUM=0
FOR A=0:0
SET A=$ORDER(^PS(55,DFN,"IV",ON,"AD",A))
if 'A
QUIT
IF $DATA(^(A,0))
SET P=^(0)
SET NUM=NUM+1
SET ^UTILITY("PSIV",$JOB,-P(2),"A",NUM)=$PIECE(P,U)_";"_$PIECE($GET(^PS(52.6,$PIECE(P,U),0)),U)_U_$PIECE(P,U,2)
+6 SET NUM=0
FOR S=0:0
SET S=$ORDER(^PS(55,DFN,"IV",ON,"SOL",S))
if 'S
QUIT
IF $DATA(^(S,0))
SET P=^(0)
SET NUM=NUM+1
SET ^UTILITY("PSIV",$JOB,-P(2),"S",NUM)=$PIECE(P,U)_";"_$PIECE($GET(^PS(52.7,$PIECE(P,U),0)),U)_U_$PIECE(P,U,2)
+7 QUIT
+8 ;
UDSET ;
+1 ; changed line below to look at .2 node for Orderable Item.
+2 KILL PSJUD,PSJFNM
+3 ;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))_"^"
+4 SET X(2)=$GET(^(2))
SET X(1)=$GET(^(.2))
SET V=$PIECE(X(2),"^",2)_"^"_$PIECE(X(2),"^",4)_"^"_$$GETDRUG_"^"_+$P(X(0),"^",2)_":VA(200,;"_$$ENNPN^PSGMI(+$PIECE(X(0),"^",2))_"^"
+5 ; PSJ*5*184 Add Discontinued/Edit
+6 SET V=V_$PIECE(X(0),"^",9)_";"_$SELECT($PIECE(X(0),"^",9)="DE":"DISCONTINUED/EDIT",1:$PIECE("ACTIVE^NON-VERIFIED^DISCONTINUED^INCOMPLETE^EXPIRED^HOLD^RENEWAL","^",$FIND("ANDIEHR",$PIECE(X(0),"^",9))-1))
+7 ;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,"^")
+8 SET Z=$GET(^PS(51.2,+$PIECE(X(0),"^",3),0))
SET V=V_"^"_$$GETAMT_"^"_$P(X(0),"^",3)_":PS(51.2,;"_$PIECE(Z,"^",3)_";"_$PIECE(Z,"^")
+9 SET Z=$PIECE(X(0),"^",7)
SET V=V_"^"_$PIECE(X(2),"^")_"^"_Z_";"_$SELECT(Z="C":"CONTINUOUS",Z="O":"ONE TIME",Z="OC":"ON CALL",Z="P":"PRN",Z="R":"FILL ON REQUEST",1:"")
FOR Z=-$PIECE(X(2),"^",2):-.00001
IF '$DATA(^UTILITY("PSG",$JOB,Z))
SET ^(Z)=V
QUIT
+10 QUIT
+11 ;
ENIVSE ; IV schedule edit
+1 SET PSJPP="PSJ"
FOR FQ=0:0
KILL DA,DIC,DR
SET DIC="^PS(51.1,"
SET DIC(0)="AELSQ"
SET DIC("DR")="4////PSJ;5////C"
SET DIC("S")="I ""C""[$P(^(0),""^"",5)"
SET D="APPSJ"
WRITE !
DO IX^DIC
if Y'>0
QUIT
SET DA=+Y
SET DIE=DIC
SET DR="[PSJI SCHEDULE EDIT]"
KILL DIC
DO ^DIE
+2 KILL C,D0,D1,FQ,PSJIVSEF,PSJPP,Z
DO ENIVKV^PSGSETU
+3 QUIT
GETDRUG() ; get orderable item or dispense drug
+1 IF '$$DISPCNT&'$D(@(PSJROOT_".2)"))
QUIT $$PRIMARY
+2 IF $$DISPCNT&'$P($GET(@(PSJROOT_".2)")),"^",2)
QUIT $$DISPDISP
+3 IF '$TEST
SET PSJFNM=$PIECE($GET(@(PSJROOT_".2)")),"^")
+4 QUIT PSJFNM_":PS(50.7,;"_$$ENPDN^PSGMI($PIECE(X(1),"^"))_" "_$PIECE($GET(^PS(50.606,$PIECE($GET(^PS(50.7,PSJFNM,0)),"^",2),0)),"^")
DISPCNT() ; returns 1 if only only one dispense drug, 0 if more than one
+1 NEW CNT,LOOP
SET (CNT,LOOP)=0
FOR
SET LOOP=$ORDER(@(PSJROOT_"1,"_LOOP_")"))
if 'LOOP
QUIT
Begin DoDot:1
+2 SET CNT=CNT+1
End DoDot:1
+3 IF CNT>1
SET CNT=0
+4 QUIT CNT
DISPDISP() ; return Dispense drug name
+1 NEW LOOP
+2 SET LOOP=0
FOR
SET LOOP=$ORDER(@(PSJROOT_"1,"_LOOP_")"))
if 'LOOP
QUIT
Begin DoDot:1
+3 SET PSJTEXT=$PIECE($GET(^PSDRUG($PIECE($GET(@(PSJROOT_"1,LOOP,0)")),"^"),0)),"^")
+4 SET PSJFNM=$PIECE($GET(@(PSJROOT_"1,LOOP,0)")),"^")
+5 SET PSJUD=$PIECE($GET(@(PSJROOT_"1,LOOP,0)")),"^",2)
+6 IF PSJUD=""
SET PSJUD=1
End DoDot:1
+7 QUIT PSJFNM_":PSDRUG(;"_PSJTEXT
GETAMT() ; get dosage ordered or units per dose
+1 QUIT $SELECT($DATA(PSJUD):PSJUD,1:$PIECE(X(1),"^",2))
PRIMARY() ; return Primary drug, order has no Orderable Item node
+1 SET PSJTEXT=$PIECE($GET(^PS(50.3,+$PIECE($GET(@(PSJROOT_".1)")),"^"),0)),"^")
+2 SET PSJFNM=$PIECE($GET(@(PSJROOT_".1)")),"^")
+3 SET PSJUD=$PIECE($GET(@(PSJROOT_".1)")),"^",2)
+4 QUIT PSJFNM_":PS(50.3;"_$SELECT($LENGTH(PSJTEXT):PSJTEXT,1:"DRUG NOT FOUND")
