PSIVCHK ;BIR/PR,MLM-CHECK ORDER FOR INTEGRITY ; 2/4/20 8:47am
;;5.0;INPATIENT MEDICATIONS ;**54,58,81,111,213,113,179,248,366,385,372**;16 DEC 97;Build 153
;
; Reference to ^PS(51.1 supported by DBIA# 2177.
; Reference to ^DIE supported by DBIA# 2053.
;
;Need DFN and ON
W ! S ERR=0,P("TYP")=P(4) S:P("TYP")="C" P("TYP")=P(23) I P("TYP")="S" S P("TYP")=$S(+P(5):"P",1:"A")
I '+P("MR") W !,"*** You have not specified a med route! ",! S ERR=1
I P(11)]"" S X=P(11),X(2)=$G(P(15)) D
.N PSGSCH S PSGSCH=$G(P(9))
.D ENCHK^PSGS0 K X(2)
.I $G(P(15)) I $$ODD^PSGS0(P(15)) W !,"*** Administration times not permitted for Odd Schedules ***" S P(11)="",ERR=1 Q
.I $G(P(9))]"" I $$PRNOK^PSGS0(P(9)) W !,"*** Administration times not permitted for PRN Schedules ***" S P(11)="",ERR=1 Q
.I '$D(X) W !,"*** Your administration time(s) are in an invalid format, ",!,"*** or there are more times than indicated by the schedule !" S ERR=1
; If schedule exists in schedule file, and order's schedule is continuous,
; OR the order's schedule type is fill on request and the order's schedule is defined as continuous in schedule file,
; AND the order's schedule is not a PRN schedule, the order must have admin times.
I $G(P(9))'="" I $D(^PS(51.1,"AC","PSJ",P(9))),'$G(ERR) D
.N XC,XIEN,XTYP,XAR S (XC,XIEN)="" F XC=0:1 S XIEN=$O(^PS(51.1,"AC","PSJ",P(9),XIEN)) Q:XIEN="" S XTYP=$P(^PS(51.1,XIEN,0),"^",5) S:XTYP'="" XAR(XTYP)=""
.S XTYP="" F XC=0:1 S XTYP=$O(XAR(XTYP)) Q:XTYP=""
.I $$ODD^PSGS0($G(P(15)))!($$PRNOK^PSGS0($G(P(9)))) S P(11)="" Q
.I $G(P(15))]"" I XC<2,'$$PRNOK^PSGS0(P(9)),'$G(P(11)),($G(P(15))'="O"),'$$ONCALL^PSIVEDT1($G(P(9))),'$$ONETIME^PSIVEDT1($G(P(9))) S ERR=1 W !,"*** There are no administration times defined for this order!"
M I P(15)<0 S ERR=1 W !,"*** Time interval between doses is less than zero !"
NEW X,PSJLDD S X=0 S:P(9)]"" X=$O(^PS(51.1,"APPSJ",P(9),0))
N XX F XX=2,3 I $P(P(XX),".",2)=""!($L(P(XX))>12) S ERR=1 W !,"*** ",$S(XX=2:"Start",1:"Stop")," date is in an invalid format or must contain time !"
I P(2)>P(3) S ERR=1 W !,"*** Start date/time CANNOT be greater than the stop date/time"
I $$SCHREQ^PSJLIVFD(.P),'X D
.N PSJXSTMP S PSJXSTMP=P(9) I PSJXSTMP="" S ERR=1 Q
.N X,Y,PSGS0XT,PSGS0Y,PSGOES S PSGOES=2,X=PSJXSTMP D ENOS^PSGS0 I $G(X)]""&($G(X)=$G(PSJXSTMP)) Q
.W !," *** WARNING -- Missing or Invalid Schedule ...",! S ERR=1
;179 Add Error for before dose if given.
I $G(ON)&$G(DFN)&$G(PSIVCHG) D ;179 xtra Protection.
.S PSJLDD=$P($$EN^PSBAPIPM(DFN,ON),"^")
.;PSJ*5*248 - Changed warning message
.I PSJLDD>P(2) S ERR=1 W !,"*** Start date/time must be set AFTER last BCMA admin time ("_$$ENDTC1^PSGMI(PSJLDD)_")",!,"of this medication ***"
INF I P(8)="","AH"[P("TYP") S ERR=1 W !,"*** You have no infusion rate defined !"
I "AH"[P("TYP"),P(8)'?1N.N.1".".1N1" ml/hr",P(8)'?.E1"@"1N.N,P(8)'?1"0."1N1" ml/hr" S ERR=1 W !,"*** Your infusion rate is in an invalid format !"
I P(8)="",P("TYP")="P" S:'ERR ERR=2 W !,"*** WARNING -- You have not specified an infusion rate. "
I '$$CODES1^PSIVUTL(P("TYP"),55.01,.04)!(P("TYP")="") S ERR=1 W !,"*** Type of order is invalid !"
I '$$CODES1^PSIVUTL(P(17),55.01,100)!(P(17)="") S ERR=1 W !,"*** Status of order is invalid !"
AH ;
I "HA"[P("TYP"),(P(11)]""!(P(9)]"")) W !,$C(7),"Order type is an admixture, hyperal, or continuous syringe, and you have",!,"a schedule and/or administration times defined!"
I F Q=0:0 W !,"Ok to delete these fields" S %=1 D YN^DICN D NULSET Q:%
K % I P(6)="" S ERR=1 W !,"*** You have not entered a physician!"
;*366 - check provider credentials
I P(6)]"" N PDA,PND,TXT S PDA=+P(6),TXT="" D I ERR W !,TXT
. S PND=$G(^VA(200,PDA,0)) I PND="" S ERR=1 S TXT="*** Physician entered does not exist" Q
. I +$P(PND,U,11),($P(PND,U,11)<DT) S ERR=1 S TXT="*** Physician entered is terminated." Q
. I '$D(^XUSEC("PROVIDER",PDA))&'$D(^XUSEC("ORELSE",PDA)) S ERR=1 S TXT="*** Physician entered does not hold PROVIDER key." Q
. N PPS S PPS=$G(^VA(200,PDA,"PS")) I PPS=""!('PPS) S ERR=1 S TXT="*** Physician entered is not authorized to write medication orders." Q
. I +$P(PPS,U,4),$P(PPS,U,4)<DT S ERR=1 S TXT="*** Physician entered is no longer active."
. I $$IVDEA^PSIVEDT(.DRG,PDA,.P) S ERR=1 S TXT=""
D ^PSIVCHK1
Q
;
NULSET ;Delete admin/schedule fields for hyperals and/or admixtures
I '% W !!?2,"Enter 'YES' to delete the schedule and/or administration times fields from",!,"this order. Enter 'NO' (or '^') to leave the fields intact.",! Q
S:%=1 P(9)="",P(11)=""
Q
CKO S P16=0,PSIVEXAM=1,PSIVCT=1 D PSIVCHK S PSIVNOL=1 W ! D ^PSIVORLB K PSIVEXAM Q:'ERR
I ERR=2 F J=0:0 W !!,"Since there is a warning with this order.",!,"do you wish to re-edit this order" S %=1 D YN^DICN Q:% W !!,"Answer 'YES' to re-edit this order."
I ERR=2,%=1 S PSIVOK="57^58^59^26^39^63^64^62^10^25^1" D ^PSIVORV2,GSTRING^PSIVORE1,GTFLDS^PSIVORFE K DA,DIE,DR G CKO
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSIVCHK 4955 printed Sep 23, 2025@19:40:04 Page 2
PSIVCHK ;BIR/PR,MLM-CHECK ORDER FOR INTEGRITY ; 2/4/20 8:47am
+1 ;;5.0;INPATIENT MEDICATIONS ;**54,58,81,111,213,113,179,248,366,385,372**;16 DEC 97;Build 153
+2 ;
+3 ; Reference to ^PS(51.1 supported by DBIA# 2177.
+4 ; Reference to ^DIE supported by DBIA# 2053.
+5 ;
+6 ;Need DFN and ON
+7 WRITE !
SET ERR=0
SET P("TYP")=P(4)
if P("TYP")="C"
SET P("TYP")=P(23)
IF P("TYP")="S"
SET P("TYP")=$SELECT(+P(5):"P",1:"A")
+8 IF '+P("MR")
WRITE !,"*** You have not specified a med route! ",!
SET ERR=1
+9 IF P(11)]""
SET X=P(11)
SET X(2)=$GET(P(15))
Begin DoDot:1
+10 NEW PSGSCH
SET PSGSCH=$GET(P(9))
+11 DO ENCHK^PSGS0
KILL X(2)
+12 IF $GET(P(15))
IF $$ODD^PSGS0(P(15))
WRITE !,"*** Administration times not permitted for Odd Schedules ***"
SET P(11)=""
SET ERR=1
QUIT
+13 IF $GET(P(9))]""
IF $$PRNOK^PSGS0(P(9))
WRITE !,"*** Administration times not permitted for PRN Schedules ***"
SET P(11)=""
SET ERR=1
QUIT
+14 IF '$DATA(X)
WRITE !,"*** Your administration time(s) are in an invalid format, ",!,"*** or there are more times than indicated by the schedule !"
SET ERR=1
End DoDot:1
+15 ; If schedule exists in schedule file, and order's schedule is continuous,
+16 ; OR the order's schedule type is fill on request and the order's schedule is defined as continuous in schedule file,
+17 ; AND the order's schedule is not a PRN schedule, the order must have admin times.
+18 IF $GET(P(9))'=""
IF $DATA(^PS(51.1,"AC","PSJ",P(9)))
IF '$GET(ERR)
Begin DoDot:1
+19 NEW XC,XIEN,XTYP,XAR
SET (XC,XIEN)=""
FOR XC=0:1
SET XIEN=$ORDER(^PS(51.1,"AC","PSJ",P(9),XIEN))
if XIEN=""
QUIT
SET XTYP=$PIECE(^PS(51.1,XIEN,0),"^",5)
if XTYP'=""
SET XAR(XTYP)=""
+20 SET XTYP=""
FOR XC=0:1
SET XTYP=$ORDER(XAR(XTYP))
if XTYP=""
QUIT
+21 IF $$ODD^PSGS0($GET(P(15)))!($$PRNOK^PSGS0($GET(P(9))))
SET P(11)=""
QUIT
+22 IF $GET(P(15))]""
IF XC<2
IF '$$PRNOK^PSGS0(P(9))
IF '$GET(P(11))
IF ($GET(P(15))'="O")
IF '$$ONCALL^PSIVEDT1($GET(P(9)))
IF '$$ONETIME^PSIVEDT1($GET(P(9)))
SET ERR=1
WRITE !,"*** There are no administration times defined for this order!"
End DoDot:1
M IF P(15)<0
SET ERR=1
WRITE !,"*** Time interval between doses is less than zero !"
+1 NEW X,PSJLDD
SET X=0
if P(9)]""
SET X=$ORDER(^PS(51.1,"APPSJ",P(9),0))
+2 NEW XX
FOR XX=2,3
IF $PIECE(P(XX),".",2)=""!($LENGTH(P(XX))>12)
SET ERR=1
WRITE !,"*** ",$SELECT(XX=2:"Start",1:"Stop")," date is in an invalid format or must contain time !"
+3 IF P(2)>P(3)
SET ERR=1
WRITE !,"*** Start date/time CANNOT be greater than the stop date/time"
+4 IF $$SCHREQ^PSJLIVFD(.P)
IF 'X
Begin DoDot:1
+5 NEW PSJXSTMP
SET PSJXSTMP=P(9)
IF PSJXSTMP=""
SET ERR=1
QUIT
+6 NEW X,Y,PSGS0XT,PSGS0Y,PSGOES
SET PSGOES=2
SET X=PSJXSTMP
DO ENOS^PSGS0
IF $GET(X)]""&($GET(X)=$GET(PSJXSTMP))
QUIT
+7 WRITE !," *** WARNING -- Missing or Invalid Schedule ...",!
SET ERR=1
End DoDot:1
+8 ;179 Add Error for before dose if given.
+9 ;179 xtra Protection.
IF $GET(ON)&$GET(DFN)&$GET(PSIVCHG)
Begin DoDot:1
+10 SET PSJLDD=$PIECE($$EN^PSBAPIPM(DFN,ON),"^")
+11 ;PSJ*5*248 - Changed warning message
+12 IF PSJLDD>P(2)
SET ERR=1
WRITE !,"*** Start date/time must be set AFTER last BCMA admin time ("_$$ENDTC1^PSGMI(PSJLDD)_")",!,"of this medication ***"
End DoDot:1
INF IF P(8)=""
IF "AH"[P("TYP")
SET ERR=1
WRITE !,"*** You have no infusion rate defined !"
+1 IF "AH"[P("TYP")
IF P(8)'?1N.N.1".".1N1" ml/hr"
IF P(8)'?.E1"@"1N.N
IF P(8)'?1"0."1N1" ml/hr"
SET ERR=1
WRITE !,"*** Your infusion rate is in an invalid format !"
+2 IF P(8)=""
IF P("TYP")="P"
if 'ERR
SET ERR=2
WRITE !,"*** WARNING -- You have not specified an infusion rate. "
+3 IF '$$CODES1^PSIVUTL(P("TYP"),55.01,.04)!(P("TYP")="")
SET ERR=1
WRITE !,"*** Type of order is invalid !"
+4 IF '$$CODES1^PSIVUTL(P(17),55.01,100)!(P(17)="")
SET ERR=1
WRITE !,"*** Status of order is invalid !"
AH ;
+1 IF "HA"[P("TYP")
IF (P(11)]""!(P(9)]""))
WRITE !,$CHAR(7),"Order type is an admixture, hyperal, or continuous syringe, and you have",!,"a schedule and/or administration times defined!"
+2 IF $TEST
FOR Q=0:0
WRITE !,"Ok to delete these fields"
SET %=1
DO YN^DICN
DO NULSET
if %
QUIT
+3 KILL %
IF P(6)=""
SET ERR=1
WRITE !,"*** You have not entered a physician!"
+4 ;*366 - check provider credentials
+5 IF P(6)]""
NEW PDA,PND,TXT
SET PDA=+P(6)
SET TXT=""
Begin DoDot:1
+6 SET PND=$GET(^VA(200,PDA,0))
IF PND=""
SET ERR=1
SET TXT="*** Physician entered does not exist"
QUIT
+7 IF +$PIECE(PND,U,11)
IF ($PIECE(PND,U,11)<DT)
SET ERR=1
SET TXT="*** Physician entered is terminated."
QUIT
+8 IF '$DATA(^XUSEC("PROVIDER",PDA))&'$DATA(^XUSEC("ORELSE",PDA))
SET ERR=1
SET TXT="*** Physician entered does not hold PROVIDER key."
QUIT
+9 NEW PPS
SET PPS=$GET(^VA(200,PDA,"PS"))
IF PPS=""!('PPS)
SET ERR=1
SET TXT="*** Physician entered is not authorized to write medication orders."
QUIT
+10 IF +$PIECE(PPS,U,4)
IF $PIECE(PPS,U,4)<DT
SET ERR=1
SET TXT="*** Physician entered is no longer active."
+11 IF $$IVDEA^PSIVEDT(.DRG,PDA,.P)
SET ERR=1
SET TXT=""
End DoDot:1
IF ERR
WRITE !,TXT
+12 DO ^PSIVCHK1
+13 QUIT
+14 ;
NULSET ;Delete admin/schedule fields for hyperals and/or admixtures
+1 IF '%
WRITE !!?2,"Enter 'YES' to delete the schedule and/or administration times fields from",!,"this order. Enter 'NO' (or '^') to leave the fields intact.",!
QUIT
+2 if %=1
SET P(9)=""
SET P(11)=""
+3 QUIT
CKO SET P16=0
SET PSIVEXAM=1
SET PSIVCT=1
DO PSIVCHK
SET PSIVNOL=1
WRITE !
DO ^PSIVORLB
KILL PSIVEXAM
if 'ERR
QUIT
+1 IF ERR=2
FOR J=0:0
WRITE !!,"Since there is a warning with this order.",!,"do you wish to re-edit this order"
SET %=1
DO YN^DICN
if %
QUIT
WRITE !!,"Answer 'YES' to re-edit this order."
+2 IF ERR=2
IF %=1
SET PSIVOK="57^58^59^26^39^63^64^62^10^25^1"
DO ^PSIVORV2
DO GSTRING^PSIVORE1
DO GTFLDS^PSIVORFE
KILL DA,DIE,DR
GOTO CKO
+3 QUIT
