PXRMORXR ;SLC/AGP - Reminder Order Checks XREF;Apr 06, 2018@14:36
;;2.0;CLINICAL REMINDERS;**16,22,45**;Feb 04, 2005;Build 566
;
Q
;
;for the rules X(1)=RULE NAME, X(2)=ACTIVE FLAG, X(3)=TESTING FLAG
;
;FORMAT OF XREF ^PXD(801,"AOIR",OI,TEST,GIEN,RULEIEN)=""
XREFCHK ;
N ACTIVE,CNT,GIEN,GNAME,OI,OINAME,OUTPUT,RIEN,RNAME,RULES,TEST,TEXTIN,X,Y
;start from AOIR xref
S CNT=0,OI=0
;
;from the ADRUGR cross-reference
N IEN,PHARMITM,TYPE
S TYPE="" F S TYPE=$O(^PXD(801,"AITEM",TYPE)) Q:TYPE="" D
.S IEN=0 F S IEN=$O(^PXD(801,"AITEM",TYPE,IEN)) Q:IEN'>0 D
..S RIEN=0 F S RIEN=$O(^PXD(801,"AITEM",TYPE,IEN,RIEN)) Q:RIEN'>0 D
...D CHKRULE(RIEN,.CNT,.OUTPUT)
...S GIEN=0
...F S GIEN=$O(^PXD(801,"AITEM",TYPE,IEN,RIEN,GIEN)) Q:GIEN'>0 D
....I '$D(^PXD(801,GIEN)) D Q
.....K TEXTIN
.....S TEXTIN(1)="Reminder Orderable Item Group IEN "_GIEN_" does not exist in the file." Q
.....D BUILDMSG(1,.TEXTIN,.CNT,.OUTPUT)
....D CHKGDR(GIEN,TYPE,IEN,RIEN,.CNT,.OUTPUT)
;
;check from file structure
S GIEN=0 F S GIEN=$O(^PXD(801,GIEN)) Q:GIEN'>0 D
.K RULES
.S Y=0 F S Y=$O(^PXD(801,GIEN,3,Y)) Q:Y'>0 D
..S RIEN=+$G(^PXD(801,GIEN,3,Y,0)) I RIEN=0 Q
..S RULES(RIEN)=""
.I '$D(RULES) Q
.S X=0 F S X=$O(^PXD(801,GIEN,1.5,X)) Q:X'>0 D
..S ITEM=$G(^PXD(801,GIEN,1.5,X,0)) Q:ITEM=""
..D CHKXFRF(GIEN,ITEM,"AITEM",.RULES,.CNT,.OUTPUT)
;
D CHKGROUP(.CNT,.OUTPUT)
;write out the output
I '$D(OUTPUT) W !,"No errors found" Q
S CNT=0 F S CNT=$O(OUTPUT(CNT)) Q:CNT'>0 W !,OUTPUT(CNT)
Q
;
BUILDMSG(NIN,TEXTIN,CNT,MESS) ;
N LINE,NOUT,TEXTOUT
D FORMAT^PXRMTEXT(1,75,NIN,.TEXTIN,.NOUT,.TEXTOUT)
S CNT=CNT+1,MESS(CNT)=""
F LINE=1:1:NOUT S CNT=CNT+1,MESS(CNT)=TEXTOUT(LINE)
Q
;
CHKGROUP(CNT,OUTPUT) ;
N GIEN,ICNT,ITEM,ITMNAME,OCINCNT,OCIOCNT,TEXTIN,X
S GIEN=0 F S GIEN=$O(^PXD(801,GIEN)) Q:GIEN'>0 D
.S ICNT=0,X=0 F S X=$O(^PXD(801,GIEN,1.5,X)) Q:X'>0 D
..S ITEM=$G(^PXD(801,GIEN,1.5,X,0)) Q:ITEM=""
..S ICNT=ICNT+1
..S ITMNAME=$$GETOCINM^PXRMOCG(ITEM)
..I '$D(^PXD(801,GIEN,1.5,"OCIO",ITMNAME,X)) D
...S TEXTIN(1)="Group: "_GIEN_" item: "_ITEM_" cannot be found in xref OCIO"
...D BUILDMSG(1,.TEXTIN,.CNT,.OUTPUT)
..I '$D(^PXD(801,GIEN,1.5,"OCIN",X)) D Q
...S TEXTIN(1)="Group: "_GIEN_" item: "_X_" cannot be found in xref OCIN"
...D BUILDMSG(1,.TEXTIN,.CNT,.OUTPUT)
..I $G(^PXD(801,GIEN,1.5,"OCIN",X))'=ITMNAME D
...S TEXTIN(1)="Group: "_GIEN_" item: "_X_" value "_$G(^PXD(801,GIEN,1.5,"OCIN",X))_" does not match "_ITMNAME
...D BUILDMSG(1,.TEXTIN,.CNT,.OUTPUT)
.;count indexes
.S OCINCNT=0,X=0
.W !,OCINCNT
.F S X=$O(^PXD(801,GIEN,1.5,"OCIN",X)) Q:X'>0 S OCINCNT=OCINCNT+1
.I ICNT'=OCINCNT D
..S TEXTIN(1)="Group: "_GIEN_" Item multiple total number of items "_ICNT_" does not match the OCIN xref total number of items "_OCINCNT
..D BUILDMSG(1,.TEXTIN,.CNT,.OUTPUT)
.S OCIOCNT=0,X=""
.F S X=$O(^PXD(801,GIEN,1.5,"OCIO",X)) Q:X="" S OCIOCNT=OCIOCNT+1
.I ICNT'=OCIOCNT D
..S TEXTIN(1)="Group: "_GIEN_" Item multiple total number of items "_ICNT_" does not match the OCIO xref total number of items "_OCIOCNT
..D BUILDMSG(1,.TEXTIN,.CNT,.OUTPUT)
Q
;
CHKXFRF(GIEN,ITEM,NODE,RULES,CNT,OUTPUT) ;
N IEN,NAME,PIEN,TYPE
I ITEM[";" S TYPE=$$GETTYPE(ITEM),PIEN=+ITEM I TYPE="" Q
S IEN=0 F S IEN=$O(RULES(IEN)) Q:IEN'>0 D
.I $D(^PXD(801,"AITEM",TYPE,PIEN,IEN,GIEN)) Q
.K TEXTIN
.S TEXTIN(1)="ERROR IN AITEM CROSS-REFERENCE"
.S TEXTIN(2)="Rule ien: "_IEN_", Item ien: "_ITEM_", Group IEN: "_GIEN
.S TEXTIN(3)=" does not exist in the AITEM xref"
.D BUILDMSG(3,.TEXTIN,.CNT,.OUTPUT)
Q
;
CHKGDR(GIEN,TYPE,IEN,RIEN,CNT,OUTPUT) ;
N FOUND,GNAME,ITEM,TEXTIN,X
S GNAME=$P(^PXD(801,GIEN,0),U)
S ITEM=IEN_$$GETFILE(TYPE)
I ITEM'[";" Q
I '$D(^PXD(801,GIEN,1.5,"B",ITEM)) D
.S TEXTIN(1)="Item: "_ITEM_" does not exist in the Reminder Orderable Item Group File entry."
.D BUILDMSG(1,.TEXTIN,.CNT,.OUTPUT)
I '$D(^PXD(801,GIEN,3,"B",RIEN)) D
.S TEXTIN(1)="Rule: "_RIEN_" does not exist in the Reminder Orderable Item Group File entry node 3 B xref."
.D BUILDMSG(1,.TEXTIN,.CNT,.OUTPUT)
S FOUND=0,X=0 F S X=$O(^PXD(801,GIEN,3,X)) Q:X'>0!(FOUND=1) D
.I +$G(^PXD(801,GIEN,3,X,0))=RIEN S FOUND=1
I FOUND=0 D
.S TEXTIN(1)="Rule: "_RIEN_" does not exist in the Reminder Orderable Item Group File entry node 3."
.D BUILDMSG(1,.TEXTIN,.CNT,.OUTPUT)
Q
;
CHKRULE(RIEN,CNT,OUTPUT) ;
N NODE,RNAME,TEXTIN
I $D(^PXD(801.1,RIEN)) Q
S TEXTIN(1)="Rule Ien: "_RIEN_" does not exist in the Reminder Order Check Rule File entry."
D BUILDMSG(1,.TEXTIN,.CNT,.OUTPUT)
Q
;
;DRUGKILL(DA,OLD) ;
;N IEN,RIEN,TYPE
;S TYPE=$$GETTYPE(OLD)
;I TYPE="" Q
;S IEN=0 F S IEN=$O(^PXD(801,DA(1),3,IEN)) Q:IEN'>0 D
;.S RIEN=$P($G(^PXD(801,DA(1),3,IEN,0)),U) I +RIEN'>0 Q
;.I $D(^PXD(801,"ADRUGR",TYPE,+OLD,RIEN,DA(1))) K ^PXD(801,"ADRUGR",TYPE,+OLD,RIEN,DA(1))
;Q
;
;DRUGSET(DA,NEW) ;
;N RIEN,TYPE
;S TYPE=$$GETTYPE(NEW)
;I TYPE="" Q
;S RIEN=0 F S RIEN=$O(^PXD(801,DA(1),3,"B",RIEN)) Q:RIEN'>0 D
;.S ^PXD(801,"ADRUGR",TYPE,+NEW,RIEN,DA(1))=""
;Q
;
;DRUGKWH ;
;K ^PXD(801,"ADRUGR")
;Q
;
ITEMKILL(DA,OLD) ;
N IEN,RIEN,TYPE
S TYPE=$$GETTYPE(OLD)
I TYPE="" Q
S IEN=0 F S IEN=$O(^PXD(801,DA(1),3,IEN)) Q:IEN'>0 D
.S RIEN=$P($G(^PXD(801,DA(1),3,IEN,0)),U) I +RIEN'>0 Q
.I $D(^PXD(801,"AITEM",TYPE,+OLD,RIEN,DA(1))) K ^PXD(801,"AITEM",TYPE,+OLD,RIEN,DA(1))
Q
;
ITEMSET(DA,NEW) ;
N RIEN,TYPE
S TYPE=$$GETTYPE(NEW)
I TYPE="" Q
S RIEN=0 F S RIEN=$O(^PXD(801,DA(1),3,"B",RIEN)) Q:RIEN'>0 D
.S ^PXD(801,"AITEM",TYPE,+NEW,RIEN,DA(1))=""
Q
;
ITEMKWH ;
K ^PXD(801,"AITEM")
Q
;
;OIKAOI(DA,OLD) ;
;N IEN,RIEN
;;I '$D(^PXD(801,DA(1),3)) Q
;S IEN=0 F S IEN=$O(^PXD(801,DA(1),3,IEN)) Q:IEN'>0 D
;.S RIEN=$P($G(^PXD(801,DA(1),3,IEN,0)),U) I +RIEN'>0 Q
;.I $D(^PXD(801,"AOIR",OLD,RIEN,DA(1))) K ^PXD(801,"AOIR",OLD,RIEN,DA(1))
;Q
;
;OISAOI(DA,NEW) ;
;N RIEN
;;I '$D(^PXD(801,DA(1),3)) Q
;S RIEN=0 F S RIEN=$O(^PXD(801,DA(1),3,"B",RIEN)) Q:RIEN'>0 D
;.S ^PXD(801,"AOIR",NEW,RIEN,DA(1))=""
;Q
;
GETTYPE(TYPE) ;
N RESULT
S RESULT=$S(TYPE["PSDRUG":"DR",$P(TYPE,";",2)="PSNDF(50.6,":"DG",TYPE["PS(50.605":"DC",TYPE["RA(79.2":"RA",TYPE["ORD(101.43":"OI",$P(TYPE,";",2)="PSNDF(50.68,":"DP",1:"")
Q RESULT
;
GETFILE(TYPE) ;
Q $S(TYPE="DR":";PSDRUG(",TYPE="DC":";PS(50.605,",TYPE="DG":";PSNDF(50.6,",TYPE="RA":";RA(79.2,",TYPE="OI":";ORD(101.43,",TYPE="DP":";PSNDF(50.68,",1:"")
;
RULEKITM(DA,OLD) ;
;I OLD(1)=""!(OLD(2)="")!(OLD(3)="") Q
N DIEN,OI,TYPE
;kill AITEM index off
; kill Item Index off
S DIEN="" F S DIEN=$O(^PXD(801,DA(1),1.5,"B",DIEN)) Q:DIEN="" D
.S TYPE=$$GETTYPE(DIEN)
.I TYPE="" Q
.I $D(^PXD(801,"AITEM",TYPE,+DIEN,OLD(1),DA(1))) K ^PXD(801,"AITEM",TYPE,+DIEN,OLD(1),DA(1))
Q
;
RULESITM(DA,NEW) ;
N DIEN,OI,TYPE
;set AITEM index
S DIEN="" F S DIEN=$O(^PXD(801,DA(1),1.5,"B",DIEN)) Q:DIEN="" D
.S TYPE=$$GETTYPE(DIEN)
.I TYPE="" Q
.S ^PXD(801,"AITEM",TYPE,+DIEN,NEW(1),DA(1))=""
Q
;
TESTER ;
N CNT,DFN,DIC,DIROUT,DIRUT,DRUG,DTOUT,DUOUT,NAME,OI,ONAME,SEV,SUB,TEST,Y,X
S DIC=2,DIC("A")="Select Patient: ",DIC(0)="AEQMZ" D ^DIC
I $D(DIROUT)!($D(DIRUT)) Q
I $D(DTOUT)!($D(DUOUT)) Q
S DFN=+$P(Y,U) I DFN<=0 W !,"A Patient is required." Q
S OI=0,DRUG=0
W !,"Select an Orderable Item or press ENTER to select a Drug."
S DIC=101.43,DIC("A")="Select Orderable Item: ",DIC(0)="AEQMZ" D ^DIC
I $D(DIROUT)!($D(DIRUT)) Q
I $D(DTOUT)!($D(DUOUT)) Q
S OI=+$P(Y,U)
I +OI'>0 D
.S DIC=50,DIC("A")="Select Drug: ",DIC(0)="AEQMZ" D ^DIC
.I $D(DIROUT)!($D(DIRUT)) Q
.I $D(DTOUT)!($D(DUOUT)) Q
.S DRUG=+$P(Y,U)
I OI'>0,DRUG'>0 W !,"An Orderable Item or a Drug is required." Q
W !!
S SUB=$S(DRUG>0:DRUG,1:OI)
F TEST=0:1:1 D
.D ORDERCHK^PXRMORCH(DFN,OI,TEST,DRUG,1)
.I '$D(^TMP($J,SUB)) W !,"No "_$S(TEST=0:"Production Rules",1:"Testing Rules")_" found." Q
.W !,$S(TEST=0:"Production Rules:",1:"Testing Rules:")
.F SEV=3,2,1 D
..I '$D(^TMP($J,SUB,SEV)) W !,"No rules with a severity of "_$S(SEV=1:"High",SEV=2:"Medium",1:"Low")_" found." Q
..W !,$S(SEV=1:"High",SEV=2:"Medium",1:"Low")_" Severity Results:"
..S ONAME="",NAME=""
..F S NAME=$O(^TMP($J,SUB,SEV,NAME)) Q:NAME="" D
...I NAME'=ONAME S ONAME=NAME W !!,NAME
...S CNT=0 F S CNT=$O(^TMP($J,SUB,SEV,NAME,CNT)) Q:CNT'>0 D
....W !,^TMP($J,SUB,SEV,NAME,CNT)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMORXR 8482 printed Oct 16, 2024@17:47:48 Page 2
PXRMORXR ;SLC/AGP - Reminder Order Checks XREF;Apr 06, 2018@14:36
+1 ;;2.0;CLINICAL REMINDERS;**16,22,45**;Feb 04, 2005;Build 566
+2 ;
+3 QUIT
+4 ;
+5 ;for the rules X(1)=RULE NAME, X(2)=ACTIVE FLAG, X(3)=TESTING FLAG
+6 ;
+7 ;FORMAT OF XREF ^PXD(801,"AOIR",OI,TEST,GIEN,RULEIEN)=""
XREFCHK ;
+1 NEW ACTIVE,CNT,GIEN,GNAME,OI,OINAME,OUTPUT,RIEN,RNAME,RULES,TEST,TEXTIN,X,Y
+2 ;start from AOIR xref
+3 SET CNT=0
SET OI=0
+4 ;
+5 ;from the ADRUGR cross-reference
+6 NEW IEN,PHARMITM,TYPE
+7 SET TYPE=""
FOR
SET TYPE=$ORDER(^PXD(801,"AITEM",TYPE))
if TYPE=""
QUIT
Begin DoDot:1
+8 SET IEN=0
FOR
SET IEN=$ORDER(^PXD(801,"AITEM",TYPE,IEN))
if IEN'>0
QUIT
Begin DoDot:2
+9 SET RIEN=0
FOR
SET RIEN=$ORDER(^PXD(801,"AITEM",TYPE,IEN,RIEN))
if RIEN'>0
QUIT
Begin DoDot:3
+10 DO CHKRULE(RIEN,.CNT,.OUTPUT)
+11 SET GIEN=0
+12 FOR
SET GIEN=$ORDER(^PXD(801,"AITEM",TYPE,IEN,RIEN,GIEN))
if GIEN'>0
QUIT
Begin DoDot:4
+13 IF '$DATA(^PXD(801,GIEN))
Begin DoDot:5
+14 KILL TEXTIN
+15 SET TEXTIN(1)="Reminder Orderable Item Group IEN "_GIEN_" does not exist in the file."
QUIT
+16 DO BUILDMSG(1,.TEXTIN,.CNT,.OUTPUT)
End DoDot:5
QUIT
+17 DO CHKGDR(GIEN,TYPE,IEN,RIEN,.CNT,.OUTPUT)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+18 ;
+19 ;check from file structure
+20 SET GIEN=0
FOR
SET GIEN=$ORDER(^PXD(801,GIEN))
if GIEN'>0
QUIT
Begin DoDot:1
+21 KILL RULES
+22 SET Y=0
FOR
SET Y=$ORDER(^PXD(801,GIEN,3,Y))
if Y'>0
QUIT
Begin DoDot:2
+23 SET RIEN=+$GET(^PXD(801,GIEN,3,Y,0))
IF RIEN=0
QUIT
+24 SET RULES(RIEN)=""
End DoDot:2
+25 IF '$DATA(RULES)
QUIT
+26 SET X=0
FOR
SET X=$ORDER(^PXD(801,GIEN,1.5,X))
if X'>0
QUIT
Begin DoDot:2
+27 SET ITEM=$GET(^PXD(801,GIEN,1.5,X,0))
if ITEM=""
QUIT
+28 DO CHKXFRF(GIEN,ITEM,"AITEM",.RULES,.CNT,.OUTPUT)
End DoDot:2
End DoDot:1
+29 ;
+30 DO CHKGROUP(.CNT,.OUTPUT)
+31 ;write out the output
+32 IF '$DATA(OUTPUT)
WRITE !,"No errors found"
QUIT
+33 SET CNT=0
FOR
SET CNT=$ORDER(OUTPUT(CNT))
if CNT'>0
QUIT
WRITE !,OUTPUT(CNT)
+34 QUIT
+35 ;
BUILDMSG(NIN,TEXTIN,CNT,MESS) ;
+1 NEW LINE,NOUT,TEXTOUT
+2 DO FORMAT^PXRMTEXT(1,75,NIN,.TEXTIN,.NOUT,.TEXTOUT)
+3 SET CNT=CNT+1
SET MESS(CNT)=""
+4 FOR LINE=1:1:NOUT
SET CNT=CNT+1
SET MESS(CNT)=TEXTOUT(LINE)
+5 QUIT
+6 ;
CHKGROUP(CNT,OUTPUT) ;
+1 NEW GIEN,ICNT,ITEM,ITMNAME,OCINCNT,OCIOCNT,TEXTIN,X
+2 SET GIEN=0
FOR
SET GIEN=$ORDER(^PXD(801,GIEN))
if GIEN'>0
QUIT
Begin DoDot:1
+3 SET ICNT=0
SET X=0
FOR
SET X=$ORDER(^PXD(801,GIEN,1.5,X))
if X'>0
QUIT
Begin DoDot:2
+4 SET ITEM=$GET(^PXD(801,GIEN,1.5,X,0))
if ITEM=""
QUIT
+5 SET ICNT=ICNT+1
+6 SET ITMNAME=$$GETOCINM^PXRMOCG(ITEM)
+7 IF '$DATA(^PXD(801,GIEN,1.5,"OCIO",ITMNAME,X))
Begin DoDot:3
+8 SET TEXTIN(1)="Group: "_GIEN_" item: "_ITEM_" cannot be found in xref OCIO"
+9 DO BUILDMSG(1,.TEXTIN,.CNT,.OUTPUT)
End DoDot:3
+10 IF '$DATA(^PXD(801,GIEN,1.5,"OCIN",X))
Begin DoDot:3
+11 SET TEXTIN(1)="Group: "_GIEN_" item: "_X_" cannot be found in xref OCIN"
+12 DO BUILDMSG(1,.TEXTIN,.CNT,.OUTPUT)
End DoDot:3
QUIT
+13 IF $GET(^PXD(801,GIEN,1.5,"OCIN",X))'=ITMNAME
Begin DoDot:3
+14 SET TEXTIN(1)="Group: "_GIEN_" item: "_X_" value "_$GET(^PXD(801,GIEN,1.5,"OCIN",X))_" does not match "_ITMNAME
+15 DO BUILDMSG(1,.TEXTIN,.CNT,.OUTPUT)
End DoDot:3
End DoDot:2
+16 ;count indexes
+17 SET OCINCNT=0
SET X=0
+18 WRITE !,OCINCNT
+19 FOR
SET X=$ORDER(^PXD(801,GIEN,1.5,"OCIN",X))
if X'>0
QUIT
SET OCINCNT=OCINCNT+1
+20 IF ICNT'=OCINCNT
Begin DoDot:2
+21 SET TEXTIN(1)="Group: "_GIEN_" Item multiple total number of items "_ICNT_" does not match the OCIN xref total number of items "_OCINCNT
+22 DO BUILDMSG(1,.TEXTIN,.CNT,.OUTPUT)
End DoDot:2
+23 SET OCIOCNT=0
SET X=""
+24 FOR
SET X=$ORDER(^PXD(801,GIEN,1.5,"OCIO",X))
if X=""
QUIT
SET OCIOCNT=OCIOCNT+1
+25 IF ICNT'=OCIOCNT
Begin DoDot:2
+26 SET TEXTIN(1)="Group: "_GIEN_" Item multiple total number of items "_ICNT_" does not match the OCIO xref total number of items "_OCIOCNT
+27 DO BUILDMSG(1,.TEXTIN,.CNT,.OUTPUT)
End DoDot:2
End DoDot:1
+28 QUIT
+29 ;
CHKXFRF(GIEN,ITEM,NODE,RULES,CNT,OUTPUT) ;
+1 NEW IEN,NAME,PIEN,TYPE
+2 IF ITEM[";"
SET TYPE=$$GETTYPE(ITEM)
SET PIEN=+ITEM
IF TYPE=""
QUIT
+3 SET IEN=0
FOR
SET IEN=$ORDER(RULES(IEN))
if IEN'>0
QUIT
Begin DoDot:1
+4 IF $DATA(^PXD(801,"AITEM",TYPE,PIEN,IEN,GIEN))
QUIT
+5 KILL TEXTIN
+6 SET TEXTIN(1)="ERROR IN AITEM CROSS-REFERENCE"
+7 SET TEXTIN(2)="Rule ien: "_IEN_", Item ien: "_ITEM_", Group IEN: "_GIEN
+8 SET TEXTIN(3)=" does not exist in the AITEM xref"
+9 DO BUILDMSG(3,.TEXTIN,.CNT,.OUTPUT)
End DoDot:1
+10 QUIT
+11 ;
CHKGDR(GIEN,TYPE,IEN,RIEN,CNT,OUTPUT) ;
+1 NEW FOUND,GNAME,ITEM,TEXTIN,X
+2 SET GNAME=$PIECE(^PXD(801,GIEN,0),U)
+3 SET ITEM=IEN_$$GETFILE(TYPE)
+4 IF ITEM'[";"
QUIT
+5 IF '$DATA(^PXD(801,GIEN,1.5,"B",ITEM))
Begin DoDot:1
+6 SET TEXTIN(1)="Item: "_ITEM_" does not exist in the Reminder Orderable Item Group File entry."
+7 DO BUILDMSG(1,.TEXTIN,.CNT,.OUTPUT)
End DoDot:1
+8 IF '$DATA(^PXD(801,GIEN,3,"B",RIEN))
Begin DoDot:1
+9 SET TEXTIN(1)="Rule: "_RIEN_" does not exist in the Reminder Orderable Item Group File entry node 3 B xref."
+10 DO BUILDMSG(1,.TEXTIN,.CNT,.OUTPUT)
End DoDot:1
+11 SET FOUND=0
SET X=0
FOR
SET X=$ORDER(^PXD(801,GIEN,3,X))
if X'>0!(FOUND=1)
QUIT
Begin DoDot:1
+12 IF +$GET(^PXD(801,GIEN,3,X,0))=RIEN
SET FOUND=1
End DoDot:1
+13 IF FOUND=0
Begin DoDot:1
+14 SET TEXTIN(1)="Rule: "_RIEN_" does not exist in the Reminder Orderable Item Group File entry node 3."
+15 DO BUILDMSG(1,.TEXTIN,.CNT,.OUTPUT)
End DoDot:1
+16 QUIT
+17 ;
CHKRULE(RIEN,CNT,OUTPUT) ;
+1 NEW NODE,RNAME,TEXTIN
+2 IF $DATA(^PXD(801.1,RIEN))
QUIT
+3 SET TEXTIN(1)="Rule Ien: "_RIEN_" does not exist in the Reminder Order Check Rule File entry."
+4 DO BUILDMSG(1,.TEXTIN,.CNT,.OUTPUT)
+5 QUIT
+6 ;
+7 ;DRUGKILL(DA,OLD) ;
+8 ;N IEN,RIEN,TYPE
+9 ;S TYPE=$$GETTYPE(OLD)
+10 ;I TYPE="" Q
+11 ;S IEN=0 F S IEN=$O(^PXD(801,DA(1),3,IEN)) Q:IEN'>0 D
+12 ;.S RIEN=$P($G(^PXD(801,DA(1),3,IEN,0)),U) I +RIEN'>0 Q
+13 ;.I $D(^PXD(801,"ADRUGR",TYPE,+OLD,RIEN,DA(1))) K ^PXD(801,"ADRUGR",TYPE,+OLD,RIEN,DA(1))
+14 ;Q
+15 ;
+16 ;DRUGSET(DA,NEW) ;
+17 ;N RIEN,TYPE
+18 ;S TYPE=$$GETTYPE(NEW)
+19 ;I TYPE="" Q
+20 ;S RIEN=0 F S RIEN=$O(^PXD(801,DA(1),3,"B",RIEN)) Q:RIEN'>0 D
+21 ;.S ^PXD(801,"ADRUGR",TYPE,+NEW,RIEN,DA(1))=""
+22 ;Q
+23 ;
+24 ;DRUGKWH ;
+25 ;K ^PXD(801,"ADRUGR")
+26 ;Q
+27 ;
ITEMKILL(DA,OLD) ;
+1 NEW IEN,RIEN,TYPE
+2 SET TYPE=$$GETTYPE(OLD)
+3 IF TYPE=""
QUIT
+4 SET IEN=0
FOR
SET IEN=$ORDER(^PXD(801,DA(1),3,IEN))
if IEN'>0
QUIT
Begin DoDot:1
+5 SET RIEN=$PIECE($GET(^PXD(801,DA(1),3,IEN,0)),U)
IF +RIEN'>0
QUIT
+6 IF $DATA(^PXD(801,"AITEM",TYPE,+OLD,RIEN,DA(1)))
KILL ^PXD(801,"AITEM",TYPE,+OLD,RIEN,DA(1))
End DoDot:1
+7 QUIT
+8 ;
ITEMSET(DA,NEW) ;
+1 NEW RIEN,TYPE
+2 SET TYPE=$$GETTYPE(NEW)
+3 IF TYPE=""
QUIT
+4 SET RIEN=0
FOR
SET RIEN=$ORDER(^PXD(801,DA(1),3,"B",RIEN))
if RIEN'>0
QUIT
Begin DoDot:1
+5 SET ^PXD(801,"AITEM",TYPE,+NEW,RIEN,DA(1))=""
End DoDot:1
+6 QUIT
+7 ;
ITEMKWH ;
+1 KILL ^PXD(801,"AITEM")
+2 QUIT
+3 ;
+4 ;OIKAOI(DA,OLD) ;
+5 ;N IEN,RIEN
+6 ;;I '$D(^PXD(801,DA(1),3)) Q
+7 ;S IEN=0 F S IEN=$O(^PXD(801,DA(1),3,IEN)) Q:IEN'>0 D
+8 ;.S RIEN=$P($G(^PXD(801,DA(1),3,IEN,0)),U) I +RIEN'>0 Q
+9 ;.I $D(^PXD(801,"AOIR",OLD,RIEN,DA(1))) K ^PXD(801,"AOIR",OLD,RIEN,DA(1))
+10 ;Q
+11 ;
+12 ;OISAOI(DA,NEW) ;
+13 ;N RIEN
+14 ;;I '$D(^PXD(801,DA(1),3)) Q
+15 ;S RIEN=0 F S RIEN=$O(^PXD(801,DA(1),3,"B",RIEN)) Q:RIEN'>0 D
+16 ;.S ^PXD(801,"AOIR",NEW,RIEN,DA(1))=""
+17 ;Q
+18 ;
GETTYPE(TYPE) ;
+1 NEW RESULT
+2 SET RESULT=$SELECT(TYPE["PSDRUG":"DR",$PIECE(TYPE,";",2)="PSNDF(50.6,":"DG",TYPE["PS(50.605":"DC",TYPE["RA(79.2":"RA",TYPE["ORD(101.43":"OI",$PIECE(TYPE,";",2)="PSNDF(50.68,":"DP",1:"")
+3 QUIT RESULT
+4 ;
GETFILE(TYPE) ;
+1 QUIT $SELECT(TYPE="DR":";PSDRUG(",TYPE="DC":";PS(50.605,",TYPE="DG":";PSNDF(50.6,",TYPE="RA":";RA(79.2,",TYPE="OI":";ORD(101.43,",TYPE="DP":";PSNDF(50.68,",1:"")
+2 ;
RULEKITM(DA,OLD) ;
+1 ;I OLD(1)=""!(OLD(2)="")!(OLD(3)="") Q
+2 NEW DIEN,OI,TYPE
+3 ;kill AITEM index off
+4 ; kill Item Index off
+5 SET DIEN=""
FOR
SET DIEN=$ORDER(^PXD(801,DA(1),1.5,"B",DIEN))
if DIEN=""
QUIT
Begin DoDot:1
+6 SET TYPE=$$GETTYPE(DIEN)
+7 IF TYPE=""
QUIT
+8 IF $DATA(^PXD(801,"AITEM",TYPE,+DIEN,OLD(1),DA(1)))
KILL ^PXD(801,"AITEM",TYPE,+DIEN,OLD(1),DA(1))
End DoDot:1
+9 QUIT
+10 ;
RULESITM(DA,NEW) ;
+1 NEW DIEN,OI,TYPE
+2 ;set AITEM index
+3 SET DIEN=""
FOR
SET DIEN=$ORDER(^PXD(801,DA(1),1.5,"B",DIEN))
if DIEN=""
QUIT
Begin DoDot:1
+4 SET TYPE=$$GETTYPE(DIEN)
+5 IF TYPE=""
QUIT
+6 SET ^PXD(801,"AITEM",TYPE,+DIEN,NEW(1),DA(1))=""
End DoDot:1
+7 QUIT
+8 ;
TESTER ;
+1 NEW CNT,DFN,DIC,DIROUT,DIRUT,DRUG,DTOUT,DUOUT,NAME,OI,ONAME,SEV,SUB,TEST,Y,X
+2 SET DIC=2
SET DIC("A")="Select Patient: "
SET DIC(0)="AEQMZ"
DO ^DIC
+3 IF $DATA(DIROUT)!($DATA(DIRUT))
QUIT
+4 IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT
+5 SET DFN=+$PIECE(Y,U)
IF DFN<=0
WRITE !,"A Patient is required."
QUIT
+6 SET OI=0
SET DRUG=0
+7 WRITE !,"Select an Orderable Item or press ENTER to select a Drug."
+8 SET DIC=101.43
SET DIC("A")="Select Orderable Item: "
SET DIC(0)="AEQMZ"
DO ^DIC
+9 IF $DATA(DIROUT)!($DATA(DIRUT))
QUIT
+10 IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT
+11 SET OI=+$PIECE(Y,U)
+12 IF +OI'>0
Begin DoDot:1
+13 SET DIC=50
SET DIC("A")="Select Drug: "
SET DIC(0)="AEQMZ"
DO ^DIC
+14 IF $DATA(DIROUT)!($DATA(DIRUT))
QUIT
+15 IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT
+16 SET DRUG=+$PIECE(Y,U)
End DoDot:1
+17 IF OI'>0
IF DRUG'>0
WRITE !,"An Orderable Item or a Drug is required."
QUIT
+18 WRITE !!
+19 SET SUB=$SELECT(DRUG>0:DRUG,1:OI)
+20 FOR TEST=0:1:1
Begin DoDot:1
+21 DO ORDERCHK^PXRMORCH(DFN,OI,TEST,DRUG,1)
+22 IF '$DATA(^TMP($JOB,SUB))
WRITE !,"No "_$SELECT(TEST=0:"Production Rules",1:"Testing Rules")_" found."
QUIT
+23 WRITE !,$SELECT(TEST=0:"Production Rules:",1:"Testing Rules:")
+24 FOR SEV=3,2,1
Begin DoDot:2
+25 IF '$DATA(^TMP($JOB,SUB,SEV))
WRITE !,"No rules with a severity of "_$SELECT(SEV=1:"High",SEV=2:"Medium",1:"Low")_" found."
QUIT
+26 WRITE !,$SELECT(SEV=1:"High",SEV=2:"Medium",1:"Low")_" Severity Results:"
+27 SET ONAME=""
SET NAME=""
+28 FOR
SET NAME=$ORDER(^TMP($JOB,SUB,SEV,NAME))
if NAME=""
QUIT
Begin DoDot:3
+29 IF NAME'=ONAME
SET ONAME=NAME
WRITE !!,NAME
+30 SET CNT=0
FOR
SET CNT=$ORDER(^TMP($JOB,SUB,SEV,NAME,CNT))
if CNT'>0
QUIT
Begin DoDot:4
+31 WRITE !,^TMP($JOB,SUB,SEV,NAME,CNT)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+32 QUIT
+33 ;
