Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PXRMEFM

PXRMEFM.m

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