PXRMAPI.m

PXRMAPI ;SLC/PKR - Clinical Reminders APIs;03/06/2015  07:38

 ;;2.0;CLINICAL REMINDERS;**45**;Feb 04, 2005;Build 566

 ;========================================================

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

 ;

 ;========================================================

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)

 ;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PXRMAPI   2914     printed  Feb 18, 2025@23:09:19                                                                                                                                                                                                     Page 2

PXRMAPI   ;SLC/PKR - Clinical Reminders APIs;03/06/2015  07:38

 +1       ;;2.0;CLINICAL REMINDERS;**45**;Feb 04, 2005;Build 566

 +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       ;

 +8       ;========================================================

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       ;