- PXRMEFM ; SLC/PKR/PJH - Extract Counting Rule Management ;08/03/2006
- ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
- ;
- ;Main entry point for PXRM EXTRACT COUNTING RULES
- START(PIEN) ;
- N PXRMDONE,VALMBCK,VALMCNT,VALMSG,X,XMZ,XQORM,XQORNOD
- S X="IORESET"
- D ENDR^%ZISS
- S VALMCNT=0
- D EN^VALM("PXRM EXTRACT COUNTING RULES")
- Q
- ;
- BLDLIST ;Build workfile
- K ^TMP("PXRMEFM",$J)
- N IEN,IND,PLIST
- D LIST(.PLIST,.IEN,PIEN)
- M ^TMP("PXRMEFM",$J)=PLIST
- S VALMCNT=PLIST("VALMCNT")
- F IND=1:1:VALMCNT S ^TMP("PXRMEFM",$J,"IDX",IND,IND)=IEN(IND)
- Q
- ;
- ENTRY ;Entry code
- D BLDLIST,XQORM
- Q
- ;
- EXIT ;Exit code
- K ^TMP("PXRMEFM",$J)
- K ^TMP("PXRMEFMH",$J)
- D CLEAN^VALM10
- D FULL^VALM1
- S VALMBCK="Q"
- Q
- ;
- HDR ; Header code
- S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
- Q
- ;
- HLP ;Help code
- N ORU,ORUPRMT,SUB,XQORM
- S SUB="PXRMEFMH"
- D EN^VALM("PXRM EXTRACT HELP")
- Q
- ;
- INIT ;Init
- S VALMCNT=0
- Q
- ;
- PEXIT ;PXRM EXCH MENU protocol exit code
- S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
- ;Reset after page up/down etc
- D XQORM
- Q
- ;
- XQORM S XQORM("#")=$O(^ORD(101,"B","PXRM EXTRACT COUNTING RULE SELECT ENTRY",0))_U_"1:"_VALMCNT
- S XQORM("A")="Select Item: "
- Q
- ;
- XSEL ;PXRM EXTRACT COUNTING RULE SELECT ENTRY validation
- N SEL,IEN
- S SEL=$P(XQORNOD(0),"=",2)
- ;Remove trailing ,
- I $E(SEL,$L(SEL))="," S SEL=$E(SEL,1,$L(SEL)-1)
- ;Invalid selection
- I SEL["," D Q
- .W $C(7),!,"Only one item number allowed." H 2
- .S VALMBCK="R"
- I ('SEL)!(SEL>VALMCNT)!('$D(@VALMAR@("IDX",SEL))) D Q
- .W $C(7),!,SEL_" is not a valid item number." H 2
- .S VALMBCK="R"
- ;
- ;Get the list ien.
- S IEN=^TMP("PXRMEFM",$J,"IDX",SEL,SEL)
- ;Display/Edit Extract Finding
- D START^PXRMEFED(IEN)
- ;
- D BLDLIST
- ;
- S VALMBCK="R"
- Q
- ;
- HELP(CALL) ;General help text routine
- N HTEXT
- I CALL=1 D
- .S HTEXT(1)="Select DR to display or edit a rule."
- .S HTEXT(2)="Select ED to edit a rule"
- ;
- D HELP^PXRMEUT(.HTEXT)
- Q
- ;
- EFADD ;Add Rule Option
- ;
- ;Reset Screen Mode
- W IORESET
- ;
- ;Add Rule
- D ADD^PXRMEFED
- ;
- ;Rebuild Workfile
- D BLDLIST
- ;
- S VALMBCK="R"
- Q
- ;
- EFINQ ;Extract Finding Inquiry - PXRM EXTRACT FINDINQ DISPLAY/EDIT entry
- N IND,FRIEN,VALMY
- D EN^VALM2(XQORNOD(0))
- ;
- ;If there is no list quit.
- I '$D(VALMY) Q
- S PXRMDONE=0
- S IND=""
- F S IND=$O(VALMY(IND)) Q:(+IND=0)!(PXRMDONE) D
- .;Get the ien.
- .S FRIEN=^TMP("PXRMEFM",$J,"IDX",IND,IND)
- .D START^PXRMEFED(FRIEN)
- ;
- D BLDLIST
- ;
- S VALMBCK="R"
- Q
- ;
- LIST(RLIST,IEN,PIEN) ;Build a list of extract findings for parameter.
- N EPCLASS,IND,FNAME,NAME,PLIST
- ;Build the list in alphabetical order.
- S VALMCNT=0
- S NAME=""
- F S NAME=$O(^PXRM(810.7,"B",NAME)) Q:NAME="" D
- .S IND=$O(^PXRM(810.7,"B",NAME,"")) Q:'IND
- .S FNAME=$P($G(^PXRM(810.7,IND,0)),U)
- .S EPCLASS=$P($G(^PXRM(810.7,IND,100)),U)
- .S VALMCNT=VALMCNT+1
- .S RLIST(VALMCNT,0)=$$FRE(VALMCNT,FNAME,EPCLASS)
- .S IEN(VALMCNT)=IND
- S RLIST("VALMCNT")=VALMCNT
- Q
- ;
- FRE(NUMBER,NAME,CLASS) ;Format entry number, name
- ;and date packed.
- N TCLASS,TEMP,TNAME,TSOURCE
- S TEMP=$$RJ^XLFSTR(NUMBER,5," ")
- S TNAME=$E(NAME,1,46)
- S TEMP=TEMP_" "_$$LJ^XLFSTR(TNAME,60," ")
- S TCLASS=$S(CLASS="N":"NATIONAL",CLASS="V":"VISN",1:"LOCAL")
- S TEMP=TEMP_" "_TCLASS
- Q TEMP
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMEFM 3337 printed Jan 18, 2025@02:45:41 Page 2
- PXRMEFM ; SLC/PKR/PJH - Extract Counting Rule Management ;08/03/2006
- +1 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
- +2 ;
- +3 ;Main entry point for PXRM EXTRACT COUNTING RULES
- START(PIEN) ;
- +1 NEW PXRMDONE,VALMBCK,VALMCNT,VALMSG,X,XMZ,XQORM,XQORNOD
- +2 SET X="IORESET"
- +3 DO ENDR^%ZISS
- +4 SET VALMCNT=0
- +5 DO EN^VALM("PXRM EXTRACT COUNTING RULES")
- +6 QUIT
- +7 ;
- BLDLIST ;Build workfile
- +1 KILL ^TMP("PXRMEFM",$JOB)
- +2 NEW IEN,IND,PLIST
- +3 DO LIST(.PLIST,.IEN,PIEN)
- +4 MERGE ^TMP("PXRMEFM",$JOB)=PLIST
- +5 SET VALMCNT=PLIST("VALMCNT")
- +6 FOR IND=1:1:VALMCNT
- SET ^TMP("PXRMEFM",$JOB,"IDX",IND,IND)=IEN(IND)
- +7 QUIT
- +8 ;
- ENTRY ;Entry code
- +1 DO BLDLIST
- DO XQORM
- +2 QUIT
- +3 ;
- EXIT ;Exit code
- +1 KILL ^TMP("PXRMEFM",$JOB)
- +2 KILL ^TMP("PXRMEFMH",$JOB)
- +3 DO CLEAN^VALM10
- +4 DO FULL^VALM1
- +5 SET VALMBCK="Q"
- +6 QUIT
- +7 ;
- HDR ; Header code
- +1 SET VALMSG="+ Next Screen - Prev Screen ?? More Actions"
- +2 QUIT
- +3 ;
- HLP ;Help code
- +1 NEW ORU,ORUPRMT,SUB,XQORM
- +2 SET SUB="PXRMEFMH"
- +3 DO EN^VALM("PXRM EXTRACT HELP")
- +4 QUIT
- +5 ;
- INIT ;Init
- +1 SET VALMCNT=0
- +2 QUIT
- +3 ;
- PEXIT ;PXRM EXCH MENU protocol exit code
- +1 SET VALMSG="+ Next Screen - Prev Screen ?? More Actions"
- +2 ;Reset after page up/down etc
- +3 DO XQORM
- +4 QUIT
- +5 ;
- XQORM SET XQORM("#")=$ORDER(^ORD(101,"B","PXRM EXTRACT COUNTING RULE SELECT ENTRY",0))_U_"1:"_VALMCNT
- +1 SET XQORM("A")="Select Item: "
- +2 QUIT
- +3 ;
- XSEL ;PXRM EXTRACT COUNTING RULE SELECT ENTRY validation
- +1 NEW SEL,IEN
- +2 SET SEL=$PIECE(XQORNOD(0),"=",2)
- +3 ;Remove trailing ,
- +4 IF $EXTRACT(SEL,$LENGTH(SEL))=","
- SET SEL=$EXTRACT(SEL,1,$LENGTH(SEL)-1)
- +5 ;Invalid selection
- +6 IF SEL[","
- Begin DoDot:1
- +7 WRITE $CHAR(7),!,"Only one item number allowed."
- HANG 2
- +8 SET VALMBCK="R"
- End DoDot:1
- QUIT
- +9 IF ('SEL)!(SEL>VALMCNT)!('$DATA(@VALMAR@("IDX",SEL)))
- Begin DoDot:1
- +10 WRITE $CHAR(7),!,SEL_" is not a valid item number."
- HANG 2
- +11 SET VALMBCK="R"
- End DoDot:1
- QUIT
- +12 ;
- +13 ;Get the list ien.
- +14 SET IEN=^TMP("PXRMEFM",$JOB,"IDX",SEL,SEL)
- +15 ;Display/Edit Extract Finding
- +16 DO START^PXRMEFED(IEN)
- +17 ;
- +18 DO BLDLIST
- +19 ;
- +20 SET VALMBCK="R"
- +21 QUIT
- +22 ;
- HELP(CALL) ;General help text routine
- +1 NEW HTEXT
- +2 IF CALL=1
- Begin DoDot:1
- +3 SET HTEXT(1)="Select DR to display or edit a rule."
- +4 SET HTEXT(2)="Select ED to edit a rule"
- End DoDot:1
- +5 ;
- +6 DO HELP^PXRMEUT(.HTEXT)
- +7 QUIT
- +8 ;
- EFADD ;Add Rule Option
- +1 ;
- +2 ;Reset Screen Mode
- +3 WRITE IORESET
- +4 ;
- +5 ;Add Rule
- +6 DO ADD^PXRMEFED
- +7 ;
- +8 ;Rebuild Workfile
- +9 DO BLDLIST
- +10 ;
- +11 SET VALMBCK="R"
- +12 QUIT
- +13 ;
- EFINQ ;Extract Finding Inquiry - PXRM EXTRACT FINDINQ DISPLAY/EDIT entry
- +1 NEW IND,FRIEN,VALMY
- +2 DO EN^VALM2(XQORNOD(0))
- +3 ;
- +4 ;If there is no list quit.
- +5 IF '$DATA(VALMY)
- QUIT
- +6 SET PXRMDONE=0
- +7 SET IND=""
- +8 FOR
- SET IND=$ORDER(VALMY(IND))
- if (+IND=0)!(PXRMDONE)
- QUIT
- Begin DoDot:1
- +9 ;Get the ien.
- +10 SET FRIEN=^TMP("PXRMEFM",$JOB,"IDX",IND,IND)
- +11 DO START^PXRMEFED(FRIEN)
- End DoDot:1
- +12 ;
- +13 DO BLDLIST
- +14 ;
- +15 SET VALMBCK="R"
- +16 QUIT
- +17 ;
- LIST(RLIST,IEN,PIEN) ;Build a list of extract findings for parameter.
- +1 NEW EPCLASS,IND,FNAME,NAME,PLIST
- +2 ;Build the list in alphabetical order.
- +3 SET VALMCNT=0
- +4 SET NAME=""
- +5 FOR
- SET NAME=$ORDER(^PXRM(810.7,"B",NAME))
- if NAME=""
- QUIT
- Begin DoDot:1
- +6 SET IND=$ORDER(^PXRM(810.7,"B",NAME,""))
- if 'IND
- QUIT
- +7 SET FNAME=$PIECE($GET(^PXRM(810.7,IND,0)),U)
- +8 SET EPCLASS=$PIECE($GET(^PXRM(810.7,IND,100)),U)
- +9 SET VALMCNT=VALMCNT+1
- +10 SET RLIST(VALMCNT,0)=$$FRE(VALMCNT,FNAME,EPCLASS)
- +11 SET IEN(VALMCNT)=IND
- End DoDot:1
- +12 SET RLIST("VALMCNT")=VALMCNT
- +13 QUIT
- +14 ;
- FRE(NUMBER,NAME,CLASS) ;Format entry number, name
- +1 ;and date packed.
- +2 NEW TCLASS,TEMP,TNAME,TSOURCE
- +3 SET TEMP=$$RJ^XLFSTR(NUMBER,5," ")
- +4 SET TNAME=$EXTRACT(NAME,1,46)
- +5 SET TEMP=TEMP_" "_$$LJ^XLFSTR(TNAME,60," ")
- +6 SET TCLASS=$SELECT(CLASS="N":"NATIONAL",CLASS="V":"VISN",1:"LOCAL")
- +7 SET TEMP=TEMP_" "_TCLASS
- +8 QUIT TEMP
- +9 ;