PSGOE42 ;BIR/CML - REGULAR ORDER ENTRY (CONT.) ;Feb 02, 2022
;;5.0;INPATIENT MEDICATIONS ;**366,327,399,372**;16 DEC 97;Build 153
;
; Reference to $$SDEA^XUSER supported by DBIA #2343
;
1 I $G(PSGCLOZ) K PSGCLOZ Q ;NCC remediation *327/RJS QUIT IF STOP DATE HAS BEEN MODIFIED AND PROCESS
S:'$G(PSGPR) PSGPR=0 S:'$D(PSGPRN) PSGPRN="" ; must have provider info
; provider
;*372-cs schedule check
N PSJDEA,PSDEA,PDEA,PSPPKG S (PSDEA,PDEA)=""
I $G(PSGPDRG)]"" D G:PDEA A1
.S PSPPKG=$S(PSJPROT=1:"U",PSJPROT=3:"UI",1:"") Q:PSPPKG=""
.S PSJDEA=$$OIDEA^PSSOPKI(PSGPDRG,PSPPKG),PSDEA=$P(PSJDEA,";",2)
.I PSDEA>1,PSDEA<6 S PDEA=1
I '$G(PSJSYSU) S PSTMPI=PSGPR,PSTMPN=PSGPRN G A1
I $S(+PSJSYSU=3:0,1:$P(PSJSYSU,";",2)) G:$P(PSJSYSW0,"^",24) 5 G DONE
S PSTMPI=PSGPR,PSTMPN=PSGPRN
A1 ;
;*366 - check provider credentials
I PSGPR N PSJACT S PSJACT=$$ACTPRO^PSGOE1(PSGPR) S:'PSJACT PSGPR=0,PSGPRN=""
W !,"PROVIDER: ",$S(PSGPR:PSGPRN_"// ",1:"") R X:DTIME I X="^" W $C(7) S PSGOROE1=1 G DONE
I $S(X="":'PSGPR,1:X="@") W $C(7)," (Required)" S X="?",PSGF2=1 D ENHLP^PSGOEM(53.1,1) G 1
I X="",PSGPR S X=PSGPRN I PSGPR'=PSGPRN,$$GET1^DIQ(200,PSGPR,53.1,"I") W " "_$$GET1^DIQ(200,PSGPR,53.2)_" "_$$GET1^DIQ(200,PSGPR,53.3) S PSGFOK(1)="" G A2
S PSGF2=1 I X?1."?" D ENHLP^PSGOEM(53.1,1)
I $E(X)="^" D FF G:Y>0 @Y G 1
K DIC S DIC="^VA(200,",DIC(0)="EMQZ",DIC("S")="I $$ACTPRO^PSGOE1(+Y)" D ^DIC K DIC I Y'>0 G 1
S PSGPR=+Y,PSGPRN=$P(Y(0,0),"^"),PSGFOK(1)=""
A2 ;; START NCC T4 MODS >> 327*RJS
I $$ISCLOZ^PSJCLOZ(,,,,PSGDRG) D
.S ANQX=0 D PROVCHK^PSJCLOZ(PSGPR) ;(PSGP,PSGDRG)
.I ANQX=0 K PSTMPN,PSTMPI
I $G(ANQX) S PSGPR=PSTMPI,PSGPRN=PSTMPN W ! K ANQX G A1
;; END NCC T4 MODS << 327*RJS
;*372-cs schedule check
I PDEA S PDEA=$$SDEA^XUSER(,+PSGPR,PSDEA,,"I") I (PDEA=1)!(PDEA=2)!(+PDEA=4) D G A1
.W !,"Provider not authorized to prescribe medications in Federal Schedule "_PSDEA_".",!,"Please contact the provider.",!
5 ; self med
I '$P(PSJSYSW0,"^",24) G DONE
A5 W !,"SELF MED: " W:PSGSM]"" $P("NO^YES","^",PSGSM+1),"// " R X:DTIME I X="^"!'$T W:'$T $C(7) S PSGOROE1=1 G DONE
I "01"[X,$L(X)<2 S:PSGSM=""&(X]"") PSGSM=X W:PSGSM]"" " (",$P("NO^YES","^",PSGSM+1),")" G DONE
I X="@" W:PSGSM="" $C(7)," ??" G:PSGSM="" A5 D DEL G:%'=1 A5 S (PSGSM,PSGHSM)="" G DONE
S PSGF2=5 I X?1"^".E D FF G:Y>0 @Y G A5
I X?1."?" S PSGF2=5 D ENHLP^PSGOEM(53.1,5) G A5
D YN I S PSGSM=$E(X)="Y",PSGFOK(5)="" G 6:PSGSM,DONE
W $C(7) D ENHLP^PSGOEM(53.1,5) G A5
;
6 ; hospital supplied self med
W !,"HOSPITAL SUPPLIED SELF MED: " W:PSGHSM]"" $P("NO^YES","^",PSGHSM+1),"// " R X:DTIME I X="^"!'$T W:'$T $C(7) S PSGOROE1=1 G DONE
I "01"[X,$L(X)<2 S:PSGHSM=""&(X]"") PSGHSM=X W:PSGHSM]"" " (",$P("NO^YES","^",PSGHSM+1),")" G DONE
I X="@" W:PSGHSM="" $C(7)," ??" G:PSGHSM="" 6 D DEL G:%'=1 6 S PSGHSM="" G DONE
S PSGF2=6 I X?1"^".E D FF G:Y>0 @Y G 6
I X?1."?" D ENHLP^PSGOEM(53.1,6) G 6
D YN I S PSGHSM=$E(X)="Y" G DONE
W $C(7) S PSGF2=6 D ENHLP^PSGOEM(53.1,6) G 6
Q
;
DONE ;
K F,F0,F1,PSGF2,F3,PSG,SDT Q
;
FF ; up-arrow to another field
D ENFF^PSGOEM I Y>0,Y'=1,Y'=5 S Y=Y_"^PSGOE4"_$S("^109^13^3^7^26^"[("^"_Y_"^"):"",1:1)
Q
;
DEL ; delete entry
W !?3,"SURE YOU WANT TO DELETE" S %=0 D YN^DICN I %'=1 W $C(7)," <NOTHING DELETED>"
Q
;
YN ; yes/no as a set of codes
I X'?.U F Y=1:1:$L(X) I $E(X,Y)?1L S X=$E(X,1,Y-1)_$C($A(X,Y)-32)_$E(X,Y+1,$L(X))
F Y="NO","YES" I $P(Y,X)="" W $P(Y,X,2) Q
Q
;
2 ; dispense drug multiple
I PSGDRG,'$D(^PS(53.45,PSJSYSP,2)) S ^(2,0)="^53.4502P^1^1",^(1,0)=PSGDRG_"^"_PSGUD
K DA,DR S DIE="^PS(53.45,",DA=PSJSYSP,DR=2,DR(2,53.4502)=$S($G(PSGFOK(13)):.02,1:".01;.02") D ^DIE
I '$O(^PS(53.45,PSJSYSP,2,0)) W $C(7),!!,"WARNING: This order must have at least one dispense drug before pharmacy can",!?9,"verify it!"
I $G(PSGFOK(13)) Q
G @FB
;
IND(OI) ;*399-IND
INDA ;
N INDLST,DIR,SEL,I,INDCAT,CHK,CNT K DUOUT,DTOUT,DIROUT,DIRUT
S (CHK,CNT)=0,PSGF2=132
I '$G(OI) S Y=99,PSGIND="" G CIND
D INDCATN^PSS50P7(OI,"PSJDIND")
I '$O(^TMP($J,"PSJDIND",0)) S Y=99 G CIND
S (SEL,I)="" F S I=$O(^TMP($J,"PSJDIND",I)) Q:'I D
. S INDCAT=$P($G(^TMP($J,"PSJDIND",I)),"^")
. I $G(PSGIND)]"",INDCAT=PSGIND S CHK=1
. S CNT=CNT+1,INDLST(CNT)=INDCAT,DIR("L",CNT)=" "_CNT_" "_INDCAT S:CNT=1 SEL=CNT_":"_INDCAT S:CNT>1 SEL=SEL_";"_CNT_":"_INDCAT
W !,"INDICATION:"
S DIR(0)="SO^"_SEL_";99:Free Text entry",DIR("A")="Select INDICATION from the list"
S DIR("L")=" 99 Free Text entry"
S:CHK DIR("B")=PSGIND S:'CHK&(PSGIND]"") DIR("B")=99
S DIR("?")="This field contains the Indication For Use and must be 3-40 characters in length"
D ^DIR
I X="^"!($G(DTOUT))!($G(DIROUT)) S:'$G(PSGOEE) PSGOROE1=1 Q
I Y=99 S:CHK PSGIND="" G CIND
I X="@",$G(PSGIND)]"" D DEL G:%'=1 INDA S PSGIND="" Q
I X="@" S PSGIND="" G INDA
S PSGFOK(132)=""
S:Y>0 PSGIND=Y(0)
Q
CIND ;
I Y=99 N I,J,IND,DA D G:$G(Y)=99 CIND
. K X,Y,DIRUT,DTOUT,DUOUT,DIROUT,DIR
. S:$G(PSGIND)]"" DIR("B")=PSGIND
. S DIR(0)="53.1,132",DIR("A")="INDICATION" D ^DIR
. I X="^"!($G(DTOUT))!($G(DIROUT)) S:'$G(PSGOEE) PSGOROE1=1 Q
. I X="@",$G(PSGIND)]"" D DEL G:%'=1 INDA S PSGIND="" Q
. I X="@" S PSGIND="" G INDA
. I $L(X," ")=1,$L(X)>32 W $C(7),!?5,"MAX OF 32 CHARACTERS ALLOWED WITHOUT SPACES.",! S Y=99 Q
. S IND="" F I=1:1:$L(X," ") Q:I="" S J=$P(X," ",I) D I '$D(X) S Y=99 Q
. .I $L(J)>32 W $C(7),!?5,"MAX OF 32 CHARACTERS ALLOWED BETWEEN SPACES.",! K X Q
. .S:J]"" IND=$S($G(IND)]"":IND_" ",1:"")_J
. Q:$G(Y)=99
. S PSGIND=$$ENLU^PSGMI(IND)
. S PSGFOK(132)=""
Q
;
;do we have any changes for indication?
;compare indication passed in PSJNEWVL parameter with value stored in the field (#132) of the file (#53.1) with the IEN=+PSJORD
DIFFIND(PSJDFN,PSJORD,PSJNEWVL) ;
; PSJDFN = IEN of #2 (not required for non-verified orders)
; PSJORD = IEN of #53.1/55 + indication like "P","U","V", example = "4033P"
; PSJNEWVL the new value after editing
; returns:
; piece #1
; 1=different than the previous value
; 0=no changes
; -1=new record, no previous values
; piece #2 = value before editing if any (current value in DB)
; piece #3 = new value
N CURRVAL S CURRVAL=""
N STATUS S STATUS=0
S PSJNEWVL=$G(PSJNEWVL)
; if this is non-verified order
I PSJORD["P" D Q STATUS_U_$G(CURRVAL)_U_PSJNEWVL
. ;if node does not exist then return -1
. I '$D(^PS(53.1,+PSJORD,18)) S STATUS=-1,CURRVAL="" Q
. S CURRVAL=$$GET1^DIQ(53.1,+PSJORD,132,"E")
. S STATUS=$S(PSJNEWVL=CURRVAL:0,1:1)
; if this is Unit Dose verified order
I PSJORD["U",+$G(PSJDFN) D Q STATUS_U_$G(CURRVAL)_U_PSJNEWVL
. ;if node does not exist then return -1
. I '$D(^PS(55,+PSJDFN,5,+PSJORD,18)) S STATUS=-1,CURRVAL="" Q
. S CURRVAL=$$GET1^DIQ(55.06,+PSJORD_","_+PSJDFN_",",141)
. S STATUS=$S(PSJNEWVL=CURRVAL:0,1:1)
Q 0 ; there is no difference by default
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSGOE42 6924 printed Nov 22, 2024@17:12 Page 2
PSGOE42 ;BIR/CML - REGULAR ORDER ENTRY (CONT.) ;Feb 02, 2022
+1 ;;5.0;INPATIENT MEDICATIONS ;**366,327,399,372**;16 DEC 97;Build 153
+2 ;
+3 ; Reference to $$SDEA^XUSER supported by DBIA #2343
+4 ;
1 ;NCC remediation *327/RJS QUIT IF STOP DATE HAS BEEN MODIFIED AND PROCESS
IF $GET(PSGCLOZ)
KILL PSGCLOZ
QUIT
+1 ; must have provider info
if '$GET(PSGPR)
SET PSGPR=0
if '$DATA(PSGPRN)
SET PSGPRN=""
+2 ; provider
+3 ;*372-cs schedule check
+4 NEW PSJDEA,PSDEA,PDEA,PSPPKG
SET (PSDEA,PDEA)=""
+5 IF $GET(PSGPDRG)]""
Begin DoDot:1
+6 SET PSPPKG=$SELECT(PSJPROT=1:"U",PSJPROT=3:"UI",1:"")
if PSPPKG=""
QUIT
+7 SET PSJDEA=$$OIDEA^PSSOPKI(PSGPDRG,PSPPKG)
SET PSDEA=$PIECE(PSJDEA,";",2)
+8 IF PSDEA>1
IF PSDEA<6
SET PDEA=1
End DoDot:1
if PDEA
GOTO A1
+9 IF '$GET(PSJSYSU)
SET PSTMPI=PSGPR
SET PSTMPN=PSGPRN
GOTO A1
+10 IF $SELECT(+PSJSYSU=3:0,1:$PIECE(PSJSYSU,";",2))
if $PIECE(PSJSYSW0,"^",24)
GOTO 5
GOTO DONE
+11 SET PSTMPI=PSGPR
SET PSTMPN=PSGPRN
A1 ;
+1 ;*366 - check provider credentials
+2 IF PSGPR
NEW PSJACT
SET PSJACT=$$ACTPRO^PSGOE1(PSGPR)
if 'PSJACT
SET PSGPR=0
SET PSGPRN=""
+3 WRITE !,"PROVIDER: ",$SELECT(PSGPR:PSGPRN_"// ",1:"")
READ X:DTIME
IF X="^"
WRITE $CHAR(7)
SET PSGOROE1=1
GOTO DONE
+4 IF $SELECT(X="":'PSGPR,1:X="@")
WRITE $CHAR(7)," (Required)"
SET X="?"
SET PSGF2=1
DO ENHLP^PSGOEM(53.1,1)
GOTO 1
+5 IF X=""
IF PSGPR
SET X=PSGPRN
IF PSGPR'=PSGPRN
IF $$GET1^DIQ(200,PSGPR,53.1,"I")
WRITE " "_$$GET1^DIQ(200,PSGPR,53.2)_" "_$$GET1^DIQ(200,PSGPR,53.3)
SET PSGFOK(1)=""
GOTO A2
+6 SET PSGF2=1
IF X?1."?"
DO ENHLP^PSGOEM(53.1,1)
+7 IF $EXTRACT(X)="^"
DO FF
if Y>0
GOTO @Y
GOTO 1
+8 KILL DIC
SET DIC="^VA(200,"
SET DIC(0)="EMQZ"
SET DIC("S")="I $$ACTPRO^PSGOE1(+Y)"
DO ^DIC
KILL DIC
IF Y'>0
GOTO 1
+9 SET PSGPR=+Y
SET PSGPRN=$PIECE(Y(0,0),"^")
SET PSGFOK(1)=""
A2 ;; START NCC T4 MODS >> 327*RJS
+1 IF $$ISCLOZ^PSJCLOZ(,,,,PSGDRG)
Begin DoDot:1
+2 ;(PSGP,PSGDRG)
SET ANQX=0
DO PROVCHK^PSJCLOZ(PSGPR)
+3 IF ANQX=0
KILL PSTMPN,PSTMPI
End DoDot:1
+4 IF $GET(ANQX)
SET PSGPR=PSTMPI
SET PSGPRN=PSTMPN
WRITE !
KILL ANQX
GOTO A1
+5 ;; END NCC T4 MODS << 327*RJS
+6 ;*372-cs schedule check
+7 IF PDEA
SET PDEA=$$SDEA^XUSER(,+PSGPR,PSDEA,,"I")
IF (PDEA=1)!(PDEA=2)!(+PDEA=4)
Begin DoDot:1
+8 WRITE !,"Provider not authorized to prescribe medications in Federal Schedule "_PSDEA_".",!,"Please contact the provider.",!
End DoDot:1
GOTO A1
5 ; self med
+1 IF '$PIECE(PSJSYSW0,"^",24)
GOTO DONE
A5 WRITE !,"SELF MED: "
if PSGSM]""
WRITE $PIECE("NO^YES","^",PSGSM+1),"// "
READ X:DTIME
IF X="^"!'$TEST
if '$TEST
WRITE $CHAR(7)
SET PSGOROE1=1
GOTO DONE
+1 IF "01"[X
IF $LENGTH(X)<2
if PSGSM=""&(X]"")
SET PSGSM=X
if PSGSM]""
WRITE " (",$PIECE("NO^YES","^",PSGSM+1),")"
GOTO DONE
+2 IF X="@"
if PSGSM=""
WRITE $CHAR(7)," ??"
if PSGSM=""
GOTO A5
DO DEL
if %'=1
GOTO A5
SET (PSGSM,PSGHSM)=""
GOTO DONE
+3 SET PSGF2=5
IF X?1"^".E
DO FF
if Y>0
GOTO @Y
GOTO A5
+4 IF X?1."?"
SET PSGF2=5
DO ENHLP^PSGOEM(53.1,5)
GOTO A5
+5 DO YN
IF $TEST
SET PSGSM=$EXTRACT(X)="Y"
SET PSGFOK(5)=""
if PSGSM
GOTO 6
GOTO DONE
+6 WRITE $CHAR(7)
DO ENHLP^PSGOEM(53.1,5)
GOTO A5
+7 ;
6 ; hospital supplied self med
+1 WRITE !,"HOSPITAL SUPPLIED SELF MED: "
if PSGHSM]""
WRITE $PIECE("NO^YES","^",PSGHSM+1),"// "
READ X:DTIME
IF X="^"!'$TEST
if '$TEST
WRITE $CHAR(7)
SET PSGOROE1=1
GOTO DONE
+2 IF "01"[X
IF $LENGTH(X)<2
if PSGHSM=""&(X]"")
SET PSGHSM=X
if PSGHSM]""
WRITE " (",$PIECE("NO^YES","^",PSGHSM+1),")"
GOTO DONE
+3 IF X="@"
if PSGHSM=""
WRITE $CHAR(7)," ??"
if PSGHSM=""
GOTO 6
DO DEL
if %'=1
GOTO 6
SET PSGHSM=""
GOTO DONE
+4 SET PSGF2=6
IF X?1"^".E
DO FF
if Y>0
GOTO @Y
GOTO 6
+5 IF X?1."?"
DO ENHLP^PSGOEM(53.1,6)
GOTO 6
+6 DO YN
IF $TEST
SET PSGHSM=$EXTRACT(X)="Y"
GOTO DONE
+7 WRITE $CHAR(7)
SET PSGF2=6
DO ENHLP^PSGOEM(53.1,6)
GOTO 6
+8 QUIT
+9 ;
DONE ;
+1 KILL F,F0,F1,PSGF2,F3,PSG,SDT
QUIT
+2 ;
FF ; up-arrow to another field
+1 DO ENFF^PSGOEM
IF Y>0
IF Y'=1
IF Y'=5
SET Y=Y_"^PSGOE4"_$SELECT("^109^13^3^7^26^"[("^"_Y_"^"):"",1:1)
+2 QUIT
+3 ;
DEL ; delete entry
+1 WRITE !?3,"SURE YOU WANT TO DELETE"
SET %=0
DO YN^DICN
IF %'=1
WRITE $CHAR(7)," <NOTHING DELETED>"
+2 QUIT
+3 ;
YN ; yes/no as a set of codes
+1 IF X'?.U
FOR Y=1:1:$LENGTH(X)
IF $EXTRACT(X,Y)?1L
SET X=$EXTRACT(X,1,Y-1)_$CHAR($ASCII(X,Y)-32)_$EXTRACT(X,Y+1,$LENGTH(X))
+2 FOR Y="NO","YES"
IF $PIECE(Y,X)=""
WRITE $PIECE(Y,X,2)
QUIT
+3 QUIT
+4 ;
2 ; dispense drug multiple
+1 IF PSGDRG
IF '$DATA(^PS(53.45,PSJSYSP,2))
SET ^(2,0)="^53.4502P^1^1"
SET ^(1,0)=PSGDRG_"^"_PSGUD
+2 KILL DA,DR
SET DIE="^PS(53.45,"
SET DA=PSJSYSP
SET DR=2
SET DR(2,53.4502)=$SELECT($GET(PSGFOK(13)):.02,1:".01;.02")
DO ^DIE
+3 IF '$ORDER(^PS(53.45,PSJSYSP,2,0))
WRITE $CHAR(7),!!,"WARNING: This order must have at least one dispense drug before pharmacy can",!?9,"verify it!"
+4 IF $GET(PSGFOK(13))
QUIT
+5 GOTO @FB
+6 ;
IND(OI) ;*399-IND
INDA ;
+1 NEW INDLST,DIR,SEL,I,INDCAT,CHK,CNT
KILL DUOUT,DTOUT,DIROUT,DIRUT
+2 SET (CHK,CNT)=0
SET PSGF2=132
+3 IF '$GET(OI)
SET Y=99
SET PSGIND=""
GOTO CIND
+4 DO INDCATN^PSS50P7(OI,"PSJDIND")
+5 IF '$ORDER(^TMP($JOB,"PSJDIND",0))
SET Y=99
GOTO CIND
+6 SET (SEL,I)=""
FOR
SET I=$ORDER(^TMP($JOB,"PSJDIND",I))
if 'I
QUIT
Begin DoDot:1
+7 SET INDCAT=$PIECE($GET(^TMP($JOB,"PSJDIND",I)),"^")
+8 IF $GET(PSGIND)]""
IF INDCAT=PSGIND
SET CHK=1
+9 SET CNT=CNT+1
SET INDLST(CNT)=INDCAT
SET DIR("L",CNT)=" "_CNT_" "_INDCAT
if CNT=1
SET SEL=CNT_":"_INDCAT
if CNT>1
SET SEL=SEL_";"_CNT_":"_INDCAT
End DoDot:1
+10 WRITE !,"INDICATION:"
+11 SET DIR(0)="SO^"_SEL_";99:Free Text entry"
SET DIR("A")="Select INDICATION from the list"
+12 SET DIR("L")=" 99 Free Text entry"
+13 if CHK
SET DIR("B")=PSGIND
if 'CHK&(PSGIND]"")
SET DIR("B")=99
+14 SET DIR("?")="This field contains the Indication For Use and must be 3-40 characters in length"
+15 DO ^DIR
+16 IF X="^"!($GET(DTOUT))!($GET(DIROUT))
if '$GET(PSGOEE)
SET PSGOROE1=1
QUIT
+17 IF Y=99
if CHK
SET PSGIND=""
GOTO CIND
+18 IF X="@"
IF $GET(PSGIND)]""
DO DEL
if %'=1
GOTO INDA
SET PSGIND=""
QUIT
+19 IF X="@"
SET PSGIND=""
GOTO INDA
+20 SET PSGFOK(132)=""
+21 if Y>0
SET PSGIND=Y(0)
+22 QUIT
CIND ;
+1 IF Y=99
NEW I,J,IND,DA
Begin DoDot:1
+2 KILL X,Y,DIRUT,DTOUT,DUOUT,DIROUT,DIR
+3 if $GET(PSGIND)]""
SET DIR("B")=PSGIND
+4 SET DIR(0)="53.1,132"
SET DIR("A")="INDICATION"
DO ^DIR
+5 IF X="^"!($GET(DTOUT))!($GET(DIROUT))
if '$GET(PSGOEE)
SET PSGOROE1=1
QUIT
+6 IF X="@"
IF $GET(PSGIND)]""
DO DEL
if %'=1
GOTO INDA
SET PSGIND=""
QUIT
+7 IF X="@"
SET PSGIND=""
GOTO INDA
+8 IF $LENGTH(X," ")=1
IF $LENGTH(X)>32
WRITE $CHAR(7),!?5,"MAX OF 32 CHARACTERS ALLOWED WITHOUT SPACES.",!
SET Y=99
QUIT
+9 SET IND=""
FOR I=1:1:$LENGTH(X," ")
if I=""
QUIT
SET J=$PIECE(X," ",I)
Begin DoDot:2
+10 IF $LENGTH(J)>32
WRITE $CHAR(7),!?5,"MAX OF 32 CHARACTERS ALLOWED BETWEEN SPACES.",!
KILL X
QUIT
+11 if J]""
SET IND=$SELECT($GET(IND)]"":IND_" ",1:"")_J
End DoDot:2
IF '$DATA(X)
SET Y=99
QUIT
+12 if $GET(Y)=99
QUIT
+13 SET PSGIND=$$ENLU^PSGMI(IND)
+14 SET PSGFOK(132)=""
End DoDot:1
if $GET(Y)=99
GOTO CIND
+15 QUIT
+16 ;
+17 ;do we have any changes for indication?
+18 ;compare indication passed in PSJNEWVL parameter with value stored in the field (#132) of the file (#53.1) with the IEN=+PSJORD
DIFFIND(PSJDFN,PSJORD,PSJNEWVL) ;
+1 ; PSJDFN = IEN of #2 (not required for non-verified orders)
+2 ; PSJORD = IEN of #53.1/55 + indication like "P","U","V", example = "4033P"
+3 ; PSJNEWVL the new value after editing
+4 ; returns:
+5 ; piece #1
+6 ; 1=different than the previous value
+7 ; 0=no changes
+8 ; -1=new record, no previous values
+9 ; piece #2 = value before editing if any (current value in DB)
+10 ; piece #3 = new value
+11 NEW CURRVAL
SET CURRVAL=""
+12 NEW STATUS
SET STATUS=0
+13 SET PSJNEWVL=$GET(PSJNEWVL)
+14 ; if this is non-verified order
+15 IF PSJORD["P"
Begin DoDot:1
+16 ;if node does not exist then return -1
+17 IF '$DATA(^PS(53.1,+PSJORD,18))
SET STATUS=-1
SET CURRVAL=""
QUIT
+18 SET CURRVAL=$$GET1^DIQ(53.1,+PSJORD,132,"E")
+19 SET STATUS=$SELECT(PSJNEWVL=CURRVAL:0,1:1)
End DoDot:1
QUIT STATUS_U_$GET(CURRVAL)_U_PSJNEWVL
+20 ; if this is Unit Dose verified order
+21 IF PSJORD["U"
IF +$GET(PSJDFN)
Begin DoDot:1
+22 ;if node does not exist then return -1
+23 IF '$DATA(^PS(55,+PSJDFN,5,+PSJORD,18))
SET STATUS=-1
SET CURRVAL=""
QUIT
+24 SET CURRVAL=$$GET1^DIQ(55.06,+PSJORD_","_+PSJDFN_",",141)
+25 SET STATUS=$SELECT(PSJNEWVL=CURRVAL:0,1:1)
End DoDot:1
QUIT STATUS_U_$GET(CURRVAL)_U_PSJNEWVL
+26 ; there is no difference by default
QUIT 0
