- 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 Feb 18, 2025@23:33:10 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")