PXRMDESCAPI ; SLC/AGP - Clinical Reminders Description APIs.;05/08/2020
;;2.0;CLINICAL REMINDERS;**46**;Feb 04, 2005;Build 236
;========================================================
;
;Computed finding description
CF(SUB,ITEM) ;
N GLB,IEN
K ^TMP(SUB,$J)
I ITEM=+ITEM S IEN=ITEM
E S ITEM=$O(^PXRMD(811.4,"B",ITEM,""))
;perform checks
I ITEM="" Q -1_U_"Non-existent computed finding"
I $D(^PXRMD(811.4,IEN))<10 Q -1_U_"Non-existent computed finding"
I '$D(^PXRMD(811.4,IEN,1,0)) Q 0
;
S GLB="^PXRMD(811.4,"_IEN_","_1_")"
D WPFORMAT(SUB,GLB,0,78)
Q 1
;
;Reminder Definition General/Technical Descriptions
DEF(SUB,ITEM,FIELD) ;
N GLB,IEN,NUM
K ^TMP(SUB,$J)
I ITEM=+ITEM S IEN=ITEM
E S ITEM=$O(^PXD(811.9,"B",ITEM,""))
;perform checks
I ITEM="" Q -1_U_"Non-existent reminder definition"
I $D(^PXD(811.9,IEN))<10 Q -1_U_"Non-existent reminder definition"
S NUM=$S(FIELD=2:1,FIELD=3:2,1:0)
I NUM=0 Q -1_U_"Description field not defined"
I '$D(^PXD(811.9,IEN,NUM,1,0)) Q 0
;
S GLB="^PXD(811.9,"_IEN_","_NUM_")"
D WPFORMAT(SUB,GLB,0,78)
Q 1
;
;Function Finding description
FFIND(SUB,ITEM,FUNCTNUM) ;
N GLB,FFIEN,IEN,NUM
K ^TMP(SUB,$J)
I ITEM=+ITEM S IEN=ITEM
E S ITEM=$O(^PXD(811.9,"B",ITEM,""))
;perform checks
I ITEM="" Q -1_U_"Non-existent reminder definition"
I $D(^PXD(811.9,IEN))<10 Q -1_U_"Non-existent reminder definition"
I FUNCTNUM="" Q -1_U_"Function Finding number not defined"
S FFIEN=+$O(^PXD(811.9,IEN,25,"B",FUNCTNUM,""))
I FFIEN=0 Q -1_U_"Function Number: "_FUNCTNUM_" not found"
I '$D(^PXD(811.9,IEN,25,FFIEN,20,1,0)) Q 0
;
S GLB="^PXD(811.9,"_IEN_",25,"_FFIEN_",20)"
D WPFORMAT(SUB,GLB,0,78)
Q 1
;
;List Rule description
LIST(SUB,ITEM) ;
N IEN,NODE
K ^TMP(SUB,$J)
I ITEM=+ITEM S IEN=ITEM
E S ITEM=$O(^PXRM(810.4,"B",ITEM,""))
;perform checks
I ITEM="" Q -1_U_"Non-existent list rule"
I $D(^PXRM(810.4,IEN))<10 Q -1_U_"Non-existent list rule"
;
S NODE=$G(^PXRMD(810.4,IEN,0))
I $P(NODE,U,2)="" Q 0
I $P(NODE,U,2)'="" S ^TMP(SUB,$J,1,0)=$P(NODE,U,2)
Q 1
;
;Order Check Group description
OCG(SUB,ITEM) ;
N GLB,IEN
K ^TMP(SUB,$J)
I ITEM=+ITEM S IEN=ITEM
E S ITEM=$O(^PXD(801,"B",ITEM,""))
;perform checks
I ITEM="" Q -1_U_"Non-existent order check group"
I $D(^PXD(801,IEN))<10 Q -1_U_"Non-existent order check group"
I '$D(^PXD(801,IEN,1,1,0)) Q 0
;
S GLB="^PXD(801,"_IEN_","_1_")"
D WPFORMAT(SUB,GLB,0,78)
Q 1
;
;Order Check Rules description
OCR(SUB,ITEM) ;
N GLB,IEN
K ^TMP(SUB,$J)
I ITEM=+ITEM S IEN=ITEM
E S ITEM=$O(^PXD(801.1,"B",ITEM,""))
;Perform checks
I ITEM="" Q -1_U_"Non-existent order check rule"
I $D(^PXD(801.1,IEN))<10 Q -1_U_"Non-existent order check rule"
I '$D(^PXD(801.1,IEN,1,1,0)) Q 0
;
S GLB="^PXD(801.1,"_IEN_","_1_")"
D WPFORMAT(SUB,GLB,0,78)
Q 1
;
;Taxonomy Description
TAX(SUB,ITEM) ;
N GLB,IEN
K ^TMP(SUB,$J)
I ITEM=+ITEM S IEN=ITEM
E S ITEM=$O(^PXD(811.2,"B",ITEM,""))
;Perform checks
I ITEM="" Q -1_U_"Non-existent taxonomy"
I $D(^PXD(811.2,IEN))<10 Q -1_U_"Non-existent taxonomy"
I '$D(^PXD(811.2,IEN,1,1,0)) Q 0
;
S GLB="^PXD(811.2,"_IEN_","_1_")"
D WPFORMAT(SUB,GLB,0,78)
Q 1
;
;Term Description
TERM(SUB,ITEM) ;
N GLB,IEN
K ^TMP(SUB,$J)
I ITEM=+ITEM S IEN=ITEM
E S ITEM=$O(^PXRMD(811.5,"B",ITEM,""))
;Perform checks
I ITEM="" Q -1_U_"Non-existent reminder term"
I $D(^PXRMD(811.5,IEN))<10 Q -1_U_"Non-existent reminder term"
I '$D(^PXRMD(811.5,IEN,1,1,0)) Q 0
;
S GLB="^PXRMD(811.5,"_IEN_","_1_")"
D WPFORMAT(SUB,GLB,0,78)
Q 1
;
;Generic Formatter
WPFORMAT(SUB,GBL,RJC,LENGTH) ;
N DIWF,DIWL,DIWR,IND,NLINES,SC,X
K ^UTILITY($J,"W")
S DIWF="|",DIWL=RJC,DIWR=LENGTH
S IND=0
F S IND=$O(@GBL@(IND)) Q:+IND=0 D
.S X=$G(@GBL@(IND,0))
.D ^DIWP
;Find where this stuff went.
S SC=$O(^UTILITY($J,"W",""))
;Save into ^TMP.
S NLINES=^UTILITY($J,"W",SC)
F IND=1:1:NLINES D
.S ^TMP(SUB,$J,IND,0)=^UTILITY($J,"W",SC,IND,0)
K ^UTILITY($J,"W")
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMDESCAPI 4069 printed Apr 09, 2024@20:53:37 Page 2
PXRMDESCAPI ; SLC/AGP - Clinical Reminders Description APIs.;05/08/2020
+1 ;;2.0;CLINICAL REMINDERS;**46**;Feb 04, 2005;Build 236
+2 ;========================================================
+3 ;
+4 ;Computed finding description
CF(SUB,ITEM) ;
+1 NEW GLB,IEN
+2 KILL ^TMP(SUB,$JOB)
+3 IF ITEM=+ITEM
SET IEN=ITEM
+4 IF '$TEST
SET ITEM=$ORDER(^PXRMD(811.4,"B",ITEM,""))
+5 ;perform checks
+6 IF ITEM=""
QUIT -1_U_"Non-existent computed finding"
+7 IF $DATA(^PXRMD(811.4,IEN))<10
QUIT -1_U_"Non-existent computed finding"
+8 IF '$DATA(^PXRMD(811.4,IEN,1,0))
QUIT 0
+9 ;
+10 SET GLB="^PXRMD(811.4,"_IEN_","_1_")"
+11 DO WPFORMAT(SUB,GLB,0,78)
+12 QUIT 1
+13 ;
+14 ;Reminder Definition General/Technical Descriptions
DEF(SUB,ITEM,FIELD) ;
+1 NEW GLB,IEN,NUM
+2 KILL ^TMP(SUB,$JOB)
+3 IF ITEM=+ITEM
SET IEN=ITEM
+4 IF '$TEST
SET ITEM=$ORDER(^PXD(811.9,"B",ITEM,""))
+5 ;perform checks
+6 IF ITEM=""
QUIT -1_U_"Non-existent reminder definition"
+7 IF $DATA(^PXD(811.9,IEN))<10
QUIT -1_U_"Non-existent reminder definition"
+8 SET NUM=$SELECT(FIELD=2:1,FIELD=3:2,1:0)
+9 IF NUM=0
QUIT -1_U_"Description field not defined"
+10 IF '$DATA(^PXD(811.9,IEN,NUM,1,0))
QUIT 0
+11 ;
+12 SET GLB="^PXD(811.9,"_IEN_","_NUM_")"
+13 DO WPFORMAT(SUB,GLB,0,78)
+14 QUIT 1
+15 ;
+16 ;Function Finding description
FFIND(SUB,ITEM,FUNCTNUM) ;
+1 NEW GLB,FFIEN,IEN,NUM
+2 KILL ^TMP(SUB,$JOB)
+3 IF ITEM=+ITEM
SET IEN=ITEM
+4 IF '$TEST
SET ITEM=$ORDER(^PXD(811.9,"B",ITEM,""))
+5 ;perform checks
+6 IF ITEM=""
QUIT -1_U_"Non-existent reminder definition"
+7 IF $DATA(^PXD(811.9,IEN))<10
QUIT -1_U_"Non-existent reminder definition"
+8 IF FUNCTNUM=""
QUIT -1_U_"Function Finding number not defined"
+9 SET FFIEN=+$ORDER(^PXD(811.9,IEN,25,"B",FUNCTNUM,""))
+10 IF FFIEN=0
QUIT -1_U_"Function Number: "_FUNCTNUM_" not found"
+11 IF '$DATA(^PXD(811.9,IEN,25,FFIEN,20,1,0))
QUIT 0
+12 ;
+13 SET GLB="^PXD(811.9,"_IEN_",25,"_FFIEN_",20)"
+14 DO WPFORMAT(SUB,GLB,0,78)
+15 QUIT 1
+16 ;
+17 ;List Rule description
LIST(SUB,ITEM) ;
+1 NEW IEN,NODE
+2 KILL ^TMP(SUB,$JOB)
+3 IF ITEM=+ITEM
SET IEN=ITEM
+4 IF '$TEST
SET ITEM=$ORDER(^PXRM(810.4,"B",ITEM,""))
+5 ;perform checks
+6 IF ITEM=""
QUIT -1_U_"Non-existent list rule"
+7 IF $DATA(^PXRM(810.4,IEN))<10
QUIT -1_U_"Non-existent list rule"
+8 ;
+9 SET NODE=$GET(^PXRMD(810.4,IEN,0))
+10 IF $PIECE(NODE,U,2)=""
QUIT 0
+11 IF $PIECE(NODE,U,2)'=""
SET ^TMP(SUB,$JOB,1,0)=$PIECE(NODE,U,2)
+12 QUIT 1
+13 ;
+14 ;Order Check Group description
OCG(SUB,ITEM) ;
+1 NEW GLB,IEN
+2 KILL ^TMP(SUB,$JOB)
+3 IF ITEM=+ITEM
SET IEN=ITEM
+4 IF '$TEST
SET ITEM=$ORDER(^PXD(801,"B",ITEM,""))
+5 ;perform checks
+6 IF ITEM=""
QUIT -1_U_"Non-existent order check group"
+7 IF $DATA(^PXD(801,IEN))<10
QUIT -1_U_"Non-existent order check group"
+8 IF '$DATA(^PXD(801,IEN,1,1,0))
QUIT 0
+9 ;
+10 SET GLB="^PXD(801,"_IEN_","_1_")"
+11 DO WPFORMAT(SUB,GLB,0,78)
+12 QUIT 1
+13 ;
+14 ;Order Check Rules description
OCR(SUB,ITEM) ;
+1 NEW GLB,IEN
+2 KILL ^TMP(SUB,$JOB)
+3 IF ITEM=+ITEM
SET IEN=ITEM
+4 IF '$TEST
SET ITEM=$ORDER(^PXD(801.1,"B",ITEM,""))
+5 ;Perform checks
+6 IF ITEM=""
QUIT -1_U_"Non-existent order check rule"
+7 IF $DATA(^PXD(801.1,IEN))<10
QUIT -1_U_"Non-existent order check rule"
+8 IF '$DATA(^PXD(801.1,IEN,1,1,0))
QUIT 0
+9 ;
+10 SET GLB="^PXD(801.1,"_IEN_","_1_")"
+11 DO WPFORMAT(SUB,GLB,0,78)
+12 QUIT 1
+13 ;
+14 ;Taxonomy Description
TAX(SUB,ITEM) ;
+1 NEW GLB,IEN
+2 KILL ^TMP(SUB,$JOB)
+3 IF ITEM=+ITEM
SET IEN=ITEM
+4 IF '$TEST
SET ITEM=$ORDER(^PXD(811.2,"B",ITEM,""))
+5 ;Perform checks
+6 IF ITEM=""
QUIT -1_U_"Non-existent taxonomy"
+7 IF $DATA(^PXD(811.2,IEN))<10
QUIT -1_U_"Non-existent taxonomy"
+8 IF '$DATA(^PXD(811.2,IEN,1,1,0))
QUIT 0
+9 ;
+10 SET GLB="^PXD(811.2,"_IEN_","_1_")"
+11 DO WPFORMAT(SUB,GLB,0,78)
+12 QUIT 1
+13 ;
+14 ;Term Description
TERM(SUB,ITEM) ;
+1 NEW GLB,IEN
+2 KILL ^TMP(SUB,$JOB)
+3 IF ITEM=+ITEM
SET IEN=ITEM
+4 IF '$TEST
SET ITEM=$ORDER(^PXRMD(811.5,"B",ITEM,""))
+5 ;Perform checks
+6 IF ITEM=""
QUIT -1_U_"Non-existent reminder term"
+7 IF $DATA(^PXRMD(811.5,IEN))<10
QUIT -1_U_"Non-existent reminder term"
+8 IF '$DATA(^PXRMD(811.5,IEN,1,1,0))
QUIT 0
+9 ;
+10 SET GLB="^PXRMD(811.5,"_IEN_","_1_")"
+11 DO WPFORMAT(SUB,GLB,0,78)
+12 QUIT 1
+13 ;
+14 ;Generic Formatter
WPFORMAT(SUB,GBL,RJC,LENGTH) ;
+1 NEW DIWF,DIWL,DIWR,IND,NLINES,SC,X
+2 KILL ^UTILITY($JOB,"W")
+3 SET DIWF="|"
SET DIWL=RJC
SET DIWR=LENGTH
+4 SET IND=0
+5 FOR
SET IND=$ORDER(@GBL@(IND))
if +IND=0
QUIT
Begin DoDot:1
+6 SET X=$GET(@GBL@(IND,0))
+7 DO ^DIWP
End DoDot:1
+8 ;Find where this stuff went.
+9 SET SC=$ORDER(^UTILITY($JOB,"W",""))
+10 ;Save into ^TMP.
+11 SET NLINES=^UTILITY($JOB,"W",SC)
+12 FOR IND=1:1:NLINES
Begin DoDot:1
+13 SET ^TMP(SUB,$JOB,IND,0)=^UTILITY($JOB,"W",SC,IND,0)
End DoDot:1
+14 KILL ^UTILITY($JOB,"W")
+15 QUIT
+16 ;
