PXRMAPI ;SLC/PKR - Clinical Reminders APIs;Jun 10, 2024@11:48:28
;;2.0;CLINICAL REMINDERS;**45,87**;Feb 04, 2005;Build 35
;========================================================
ITEMLIST(RIEN,GNAME,LIST,SUB) ;Return a list of items for an order
;check group.
;Controlled by ICR #6029
;INPUT: RIEN - Rule IEN (file #801.1) (optional)
; GNAME - GROUP NAME (.01 field in file #801) (optional)
; LIST - type of list to return; either P, O, I or A
; P: Pharmacy item list
; O: Orderable item list
; I: Imaging Type
; A: All entries
; SUB - Name of the subscript underwhich to return data in ^TMP($J,
; (optional; defaults to "PXRMLIST")
;OUTPUT: Data is returned descendant from ^TMP($J,SUB)
; Error messages are returned in ^TMP($J,SUB,"ERROR")
N FIELD,INDEX,ITEM,TYPE,ENTRY
I $G(SUB)="" S SUB="PXRMLIST"
K ^TMP($J,SUB)
;ICR #10104
S GNAME=$$UP^XLFSTR($G(GNAME)),LIST=$$UP^XLFSTR($G(LIST))
I $G(RIEN)="",$G(GNAME)="" D Q
.S ^TMP($J,SUB,"ERROR")="You must specify either a rule IEN or a group name."
I $G(RIEN)'="",$G(GNAME)'="" D Q
.S ^TMP($J,SUB,"ERROR")="You cannot request both a rule and a group name at the same time."
I $G(GNAME)="",$G(RIEN)'?1.N!('$D(^PXD(801.1,$G(RIEN,0)))) D Q
.S ^TMP($J,SUB,"ERROR")="Invalid rule requested: "_$G(RIEN)
I $G(RIEN)="",'$D(^PXD(801,"B",GNAME)) D Q
.S ^TMP($J,SUB,"ERROR")="Invalid group name requested: "_GNAME
I $L(LIST)'=1!("POIA"'[LIST) D Q
.S ^TMP($J,SUB,"ERROR")="Invalid list requested: "_LIST_"; specify either P, O, I or A"
I $G(RIEN) D Q:$D(^TMP($J,SUB,"ERROR"))
.N IEN2
.S IEN2=0 F S IEN2=$O(^PXD(801,"R",RIEN,IEN2)) Q:'IEN2 D
..S ENTRY(IEN2)=$P($G(^PXD(801,IEN2,0)),U)
.I $D(ENTRY)'=10 S ^TMP($J,SUB,"ERROR")="Invalid rule requested: "_RIEN
I GNAME'="" D Q:$D(^TMP($J,SUB,"ERROR"))
.S ENTRY($O(^PXD(801,"B",GNAME,0)))=GNAME
.I $D(ENTRY(0)) S ^TMP($J,SUB,"ERROR")="Invalid name requested: "_GNAME
S INDEX=0 F S INDEX=$O(ENTRY(INDEX)) Q:'INDEX D
.S INDEX(3)=0 F S INDEX(3)=$O(^PXD(801,INDEX,1.5,"B",INDEX(3))) Q:'INDEX(3) D
..S TYPE=$$GETTYPE(INDEX(3)) I TYPE="" Q
..S ^TMP($J,SUB,ENTRY(INDEX),TYPE,INDEX(3))=""
Q
;
GETTYPE(TYPE) ;
Q $S(TYPE["PSDRUG":"P",TYPE["PSNDF(50.6":"P",TYPE["PS(50.605":"P",TYPE["RA(79.2":"I",TYPE["ORD(101.43":"O",1:"")
;========================================================
PUSAGE(IEN) ;Return true if the reminder definition contains a "P"
;in the Usage field. This means it is ok for a patient to use the
;reminder. IEN is the internal entry number.
N OK,USAGE
S USAGE=$P($G(^PXD(811.9,IEN,100)),U,4)
S OK=$S(USAGE["P":1,1:0)
Q OK
;
STATMTCH(REMSTAT,RULESTAT) ;
I RULESTAT="D",REMSTAT["DUE" Q 1
I RULESTAT="A",REMSTAT'="N/A",REMSTAT'="NEVER",REMSTAT'="CONTRA",REMSTAT'="REFUSED" Q 1
I RULESTAT="N",$E(REMSTAT,1)="N"!(REMSTAT="CONTRA")!(REMSTAT="REFUSED") Q 1
I RULESTAT="R",REMSTAT["RESOLVE" Q 1
Q 0
;
;========================================================
USAGE(IEN) ;Return the Usage for a reminder definition. IEN is the
;internal entry number.
Q $P($G(^PXD(811.9,IEN,100)),U,4)
;
ISACTIVE(FN,IEN) ;
I FN=811.9,$P($G(^PXD(811.9,IEN,0)),U,6)=1 Q 0
I FN=801.41,+$P($G(^PXRMD(801.41,IEN,0)),U,3)>0 Q 0
Q 1
;
INFOLIST(RESULTS) ;
N IEN,NAME
S IEN=0 F S IEN=$O(^PXD(811.9,"I",IEN)) Q:IEN'>0 D
.I $P($G(^PXD(811.9,IEN,0)),U,6)=1 Q
.S NAME=$P($G(^PXD(811.9,IEN,0)),U) I NAME="" Q
.S RESULTS("RD."_NAME)=IEN_";PXD(811.9,"
S IEN=0 F S IEN=$O(^PXRMD(811.5,"I",IEN)) Q:IEN'>0 D
.S NAME=$P($G(^PXRMD(811.5,IEN,0)),U) I NAME="" Q
.S RESULTS("RT."_NAME)=IEN_";PXRMD(811.5,"
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMAPI 3718 printed May 25, 2026@11:46:23 Page 2
PXRMAPI ;SLC/PKR - Clinical Reminders APIs;Jun 10, 2024@11:48:28
+1 ;;2.0;CLINICAL REMINDERS;**45,87**;Feb 04, 2005;Build 35
+2 ;========================================================
ITEMLIST(RIEN,GNAME,LIST,SUB) ;Return a list of items for an order
+1 ;check group.
+2 ;Controlled by ICR #6029
+3 ;INPUT: RIEN - Rule IEN (file #801.1) (optional)
+4 ; GNAME - GROUP NAME (.01 field in file #801) (optional)
+5 ; LIST - type of list to return; either P, O, I or A
+6 ; P: Pharmacy item list
+7 ; O: Orderable item list
+8 ; I: Imaging Type
+9 ; A: All entries
+10 ; SUB - Name of the subscript underwhich to return data in ^TMP($J,
+11 ; (optional; defaults to "PXRMLIST")
+12 ;OUTPUT: Data is returned descendant from ^TMP($J,SUB)
+13 ; Error messages are returned in ^TMP($J,SUB,"ERROR")
+14 NEW FIELD,INDEX,ITEM,TYPE,ENTRY
+15 IF $GET(SUB)=""
SET SUB="PXRMLIST"
+16 KILL ^TMP($JOB,SUB)
+17 ;ICR #10104
+18 SET GNAME=$$UP^XLFSTR($GET(GNAME))
SET LIST=$$UP^XLFSTR($GET(LIST))
+19 IF $GET(RIEN)=""
IF $GET(GNAME)=""
Begin DoDot:1
+20 SET ^TMP($JOB,SUB,"ERROR")="You must specify either a rule IEN or a group name."
End DoDot:1
QUIT
+21 IF $GET(RIEN)'=""
IF $GET(GNAME)'=""
Begin DoDot:1
+22 SET ^TMP($JOB,SUB,"ERROR")="You cannot request both a rule and a group name at the same time."
End DoDot:1
QUIT
+23 IF $GET(GNAME)=""
IF $GET(RIEN)'?1.N!('$DATA(^PXD(801.1,$GET(RIEN,0))))
Begin DoDot:1
+24 SET ^TMP($JOB,SUB,"ERROR")="Invalid rule requested: "_$GET(RIEN)
End DoDot:1
QUIT
+25 IF $GET(RIEN)=""
IF '$DATA(^PXD(801,"B",GNAME))
Begin DoDot:1
+26 SET ^TMP($JOB,SUB,"ERROR")="Invalid group name requested: "_GNAME
End DoDot:1
QUIT
+27 IF $LENGTH(LIST)'=1!("POIA"'[LIST)
Begin DoDot:1
+28 SET ^TMP($JOB,SUB,"ERROR")="Invalid list requested: "_LIST_"; specify either P, O, I or A"
End DoDot:1
QUIT
+29 IF $GET(RIEN)
Begin DoDot:1
+30 NEW IEN2
+31 SET IEN2=0
FOR
SET IEN2=$ORDER(^PXD(801,"R",RIEN,IEN2))
if 'IEN2
QUIT
Begin DoDot:2
+32 SET ENTRY(IEN2)=$PIECE($GET(^PXD(801,IEN2,0)),U)
End DoDot:2
+33 IF $DATA(ENTRY)'=10
SET ^TMP($JOB,SUB,"ERROR")="Invalid rule requested: "_RIEN
End DoDot:1
if $DATA(^TMP($JOB,SUB,"ERROR"))
QUIT
+34 IF GNAME'=""
Begin DoDot:1
+35 SET ENTRY($ORDER(^PXD(801,"B",GNAME,0)))=GNAME
+36 IF $DATA(ENTRY(0))
SET ^TMP($JOB,SUB,"ERROR")="Invalid name requested: "_GNAME
End DoDot:1
if $DATA(^TMP($JOB,SUB,"ERROR"))
QUIT
+37 SET INDEX=0
FOR
SET INDEX=$ORDER(ENTRY(INDEX))
if 'INDEX
QUIT
Begin DoDot:1
+38 SET INDEX(3)=0
FOR
SET INDEX(3)=$ORDER(^PXD(801,INDEX,1.5,"B",INDEX(3)))
if 'INDEX(3)
QUIT
Begin DoDot:2
+39 SET TYPE=$$GETTYPE(INDEX(3))
IF TYPE=""
QUIT
+40 SET ^TMP($JOB,SUB,ENTRY(INDEX),TYPE,INDEX(3))=""
End DoDot:2
End DoDot:1
+41 QUIT
+42 ;
GETTYPE(TYPE) ;
+1 QUIT $SELECT(TYPE["PSDRUG":"P",TYPE["PSNDF(50.6":"P",TYPE["PS(50.605":"P",TYPE["RA(79.2":"I",TYPE["ORD(101.43":"O",1:"")
+2 ;========================================================
PUSAGE(IEN) ;Return true if the reminder definition contains a "P"
+1 ;in the Usage field. This means it is ok for a patient to use the
+2 ;reminder. IEN is the internal entry number.
+3 NEW OK,USAGE
+4 SET USAGE=$PIECE($GET(^PXD(811.9,IEN,100)),U,4)
+5 SET OK=$SELECT(USAGE["P":1,1:0)
+6 QUIT OK
+7 ;
STATMTCH(REMSTAT,RULESTAT) ;
+1 IF RULESTAT="D"
IF REMSTAT["DUE"
QUIT 1
+2 IF RULESTAT="A"
IF REMSTAT'="N/A"
IF REMSTAT'="NEVER"
IF REMSTAT'="CONTRA"
IF REMSTAT'="REFUSED"
QUIT 1
+3 IF RULESTAT="N"
IF $EXTRACT(REMSTAT,1)="N"!(REMSTAT="CONTRA")!(REMSTAT="REFUSED")
QUIT 1
+4 IF RULESTAT="R"
IF REMSTAT["RESOLVE"
QUIT 1
+5 QUIT 0
+6 ;
+7 ;========================================================
USAGE(IEN) ;Return the Usage for a reminder definition. IEN is the
+1 ;internal entry number.
+2 QUIT $PIECE($GET(^PXD(811.9,IEN,100)),U,4)
+3 ;
ISACTIVE(FN,IEN) ;
+1 IF FN=811.9
IF $PIECE($GET(^PXD(811.9,IEN,0)),U,6)=1
QUIT 0
+2 IF FN=801.41
IF +$PIECE($GET(^PXRMD(801.41,IEN,0)),U,3)>0
QUIT 0
+3 QUIT 1
+4 ;
INFOLIST(RESULTS) ;
+1 NEW IEN,NAME
+2 SET IEN=0
FOR
SET IEN=$ORDER(^PXD(811.9,"I",IEN))
if IEN'>0
QUIT
Begin DoDot:1
+3 IF $PIECE($GET(^PXD(811.9,IEN,0)),U,6)=1
QUIT
+4 SET NAME=$PIECE($GET(^PXD(811.9,IEN,0)),U)
IF NAME=""
QUIT
+5 SET RESULTS("RD."_NAME)=IEN_";PXD(811.9,"
End DoDot:1
+6 SET IEN=0
FOR
SET IEN=$ORDER(^PXRMD(811.5,"I",IEN))
if IEN'>0
QUIT
Begin DoDot:1
+7 SET NAME=$PIECE($GET(^PXRMD(811.5,IEN,0)),U)
IF NAME=""
QUIT
+8 SET RESULTS("RT."_NAME)=IEN_";PXRMD(811.5,"
End DoDot:1
+9 QUIT
+10 ;
