PXRMRUTL ; SLC/PJH - Reminder utilities. ;03/24/2003
;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
;
;
;Store file details used by findings in array form
;-------------------------------------------------
DEF(FILENUM,DEF,DEF1,DEF2) ;
N DATA,DESC,FILE,GSUB,LIST,SEQ,TYPE
;Get variable pointer details from data dictionary
D BLDRLIST^PXRMVPTR(FILENUM,".01",.LIST)
;
S GSUB="",DEF=0
F S GSUB=$O(LIST(GSUB)) Q:GSUB="" D
.S DATA=$G(LIST(GSUB)) Q:DATA=""
.S FILE=$P(DATA,U),DESC=$P(DATA,U,2),SEQ=$P(DATA,U,3),TYPE=$P(DATA,U,4)
.Q:(FILE="")!(TYPE="")!(SEQ="")!(DESC="")
.;Save number of files (using sequence number)
.I SEQ>DEF S DEF=SEQ
.;Save file type and description in sequence (used in DIR prompt)
.S DEF(SEQ)=TYPE_":"_DESC
.;Build index to file type from global reference
.S DEF1(GSUB)=TYPE
.;Build Index to description from file type
.S DEF2(TYPE)=DESC
.;Build Index to file number from file type
.S DEF2(TYPE,1)=FILE
Q
;
DUMMY W !!,"This option is not yet available",!!,*7 H 1
Q
;
DUMMY1 D BMES^XPDUTL("Option is not yet available.") H 2
S VALMBCK="R"
Q
;
;
TEST(ARRAY,DIEN) ;Dialog test
D LOAD^PXRMDLL(DIEN) M ARRAY=ORY
;
N DSEQ,DIEN,DCUR,DSUB,DTTYP,OCNT,SUB,ARRAYN
S OCNT=$O(ARRAY(""),-1)+1,ARRAY(OCNT)=$J("",79)
S OCNT=OCNT+1,ARRAY(OCNT)="Additional prompts"
S OCNT=OCNT+1,ARRAY(OCNT)=$J("",79)
S SUB=""
F S SUB=$O(ORY(SUB)) Q:'SUB D
.I $P(ORY(SUB),U)'=1 Q
.S DIEN=$P(ORY(SUB),U,2),DSEQ=$P(ORY(SUB),U,3)
.S DTTYP=$P(ORY(SUB),U,7),DCUR=$P(ORY(SUB),U,8)
.;Ignore group headers
.Q:DCUR="D"
.K ARRAYN D TESTL(.ARRAYN,DIEN,DCUR,DTTYP)
.S DSUB=""
.F S DSUB=$O(ARRAYN(DSUB)) Q:'DSUB D
..S OCNT=OCNT+1,ARRAY(OCNT)=ARRAYN(DSUB)
.S OCNT=OCNT+1,ARRAY(OCNT)=$J("",79)
Q
;
TESTL(ORY,DITEM,DCUR,DTTYP) ;Dialog load
D LOAD^PXRMDLLA(DITEM,DCUR,DTTYP)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMRUTL 1855 printed Dec 13, 2024@01:49:01 Page 2
PXRMRUTL ; SLC/PJH - Reminder utilities. ;03/24/2003
+1 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
+2 ;
+3 ;
+4 ;Store file details used by findings in array form
+5 ;-------------------------------------------------
DEF(FILENUM,DEF,DEF1,DEF2) ;
+1 NEW DATA,DESC,FILE,GSUB,LIST,SEQ,TYPE
+2 ;Get variable pointer details from data dictionary
+3 DO BLDRLIST^PXRMVPTR(FILENUM,".01",.LIST)
+4 ;
+5 SET GSUB=""
SET DEF=0
+6 FOR
SET GSUB=$ORDER(LIST(GSUB))
if GSUB=""
QUIT
Begin DoDot:1
+7 SET DATA=$GET(LIST(GSUB))
if DATA=""
QUIT
+8 SET FILE=$PIECE(DATA,U)
SET DESC=$PIECE(DATA,U,2)
SET SEQ=$PIECE(DATA,U,3)
SET TYPE=$PIECE(DATA,U,4)
+9 if (FILE="")!(TYPE="")!(SEQ="")!(DESC="")
QUIT
+10 ;Save number of files (using sequence number)
+11 IF SEQ>DEF
SET DEF=SEQ
+12 ;Save file type and description in sequence (used in DIR prompt)
+13 SET DEF(SEQ)=TYPE_":"_DESC
+14 ;Build index to file type from global reference
+15 SET DEF1(GSUB)=TYPE
+16 ;Build Index to description from file type
+17 SET DEF2(TYPE)=DESC
+18 ;Build Index to file number from file type
+19 SET DEF2(TYPE,1)=FILE
End DoDot:1
+20 QUIT
+21 ;
DUMMY WRITE !!,"This option is not yet available",!!,*7
HANG 1
+1 QUIT
+2 ;
DUMMY1 DO BMES^XPDUTL("Option is not yet available.")
HANG 2
+1 SET VALMBCK="R"
+2 QUIT
+3 ;
+4 ;
TEST(ARRAY,DIEN) ;Dialog test
+1 DO LOAD^PXRMDLL(DIEN)
MERGE ARRAY=ORY
+2 ;
+3 NEW DSEQ,DIEN,DCUR,DSUB,DTTYP,OCNT,SUB,ARRAYN
+4 SET OCNT=$ORDER(ARRAY(""),-1)+1
SET ARRAY(OCNT)=$JUSTIFY("",79)
+5 SET OCNT=OCNT+1
SET ARRAY(OCNT)="Additional prompts"
+6 SET OCNT=OCNT+1
SET ARRAY(OCNT)=$JUSTIFY("",79)
+7 SET SUB=""
+8 FOR
SET SUB=$ORDER(ORY(SUB))
if 'SUB
QUIT
Begin DoDot:1
+9 IF $PIECE(ORY(SUB),U)'=1
QUIT
+10 SET DIEN=$PIECE(ORY(SUB),U,2)
SET DSEQ=$PIECE(ORY(SUB),U,3)
+11 SET DTTYP=$PIECE(ORY(SUB),U,7)
SET DCUR=$PIECE(ORY(SUB),U,8)
+12 ;Ignore group headers
+13 if DCUR="D"
QUIT
+14 KILL ARRAYN
DO TESTL(.ARRAYN,DIEN,DCUR,DTTYP)
+15 SET DSUB=""
+16 FOR
SET DSUB=$ORDER(ARRAYN(DSUB))
if 'DSUB
QUIT
Begin DoDot:2
+17 SET OCNT=OCNT+1
SET ARRAY(OCNT)=ARRAYN(DSUB)
End DoDot:2
+18 SET OCNT=OCNT+1
SET ARRAY(OCNT)=$JUSTIFY("",79)
End DoDot:1
+19 QUIT
+20 ;
TESTL(ORY,DITEM,DCUR,DTTYP) ;Dialog load
+1 DO LOAD^PXRMDLLA(DITEM,DCUR,DTTYP)
+2 QUIT
