- 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 Feb 18, 2025@23:15:24 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