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

PXRMEPM.m

Go to the documentation of this file.
  1. PXRMEPM ; SLC/PKR/PJH - Extract Definition Management ;07/17/2007
  1. ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123
  1. ;
  1. ;Main entry point for PXRM EXTRACT DEFINITIONS
  1. START 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 DEFINITIONS")
  1. Q
  1. ;
  1. BLDLIST ;Build workfile
  1. K ^TMP("PXRMEPM",$J)
  1. N IEN,IND,PLIST
  1. D LIST^PXRMETM("PXRMEPM",.VALMCNT)
  1. Q
  1. ;
  1. ENTRY ;Entry code
  1. D BLDLIST,XQORM
  1. Q
  1. ;
  1. EXIT ;Exit code
  1. K ^TMP("PXRMEPM",$J)
  1. K ^TMP("PXRMEPMH",$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="PXRMEPMH"
  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 DEFINITION SELECT ENTRY",0))_U_"1:"_VALMCNT
  1. S XQORM("A")="Select Item: "
  1. Q
  1. ;
  1. XSEL ;PXRM EXTRACT DEFINITION 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@("SEL",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("PXRMEPM",$J,"SEL",SEL)
  1. ;Display/Edit Extract Definition
  1. D START^PXRMEPED(IEN)
  1. D BLDLIST
  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 DE to display or edit a definition."
  1. .S HTEXT(2)="Select ED to edit a definition"
  1. D HELP^PXRMEUT(.HTEXT)
  1. Q
  1. ;
  1. EPADD ;Add Rule Option
  1. ;Reset Screen Mode
  1. W IORESET
  1. ;
  1. ;Add Rule
  1. D ADD^PXRMEPED
  1. ;
  1. ;Rebuild Workfile
  1. D BLDLIST
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. EPINQ ;Definition Inquiry - PXRM EXTRACT DEFINITION DISPLAY/EDIT entry
  1. N IND,LRIEN,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 LRIEN=^TMP("PXRMEPM",$J,"SEL",IND)
  1. .D START^PXRMEPED(LRIEN)
  1. D BLDLIST
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. PPLR ;Display rule set components
  1. ;used by [PXRM EXTRACT DEFINITION] template)
  1. N ACT,DATA,FIRST,IEN,LRDATA,LRIEN,SEQ,SUB
  1. S IEN=$P(X,U,2) Q:'IEN
  1. W !," Description: ",$P($G(^PXRM(810.4,IEN,0)),U,2)
  1. S SEQ="",FIRST=1
  1. F S SEQ=$O(^PXRM(810.4,IEN,30,"B",SEQ)) Q:'SEQ D
  1. .S SUB=$O(^PXRM(810.4,IEN,30,"B",SEQ,"")) Q:'SUB
  1. .S DATA=$G(^PXRM(810.4,IEN,30,SUB,0)) Q:DATA=""
  1. .S LRIEN=$P(DATA,U,2) Q:LRIEN=""
  1. .S ACT=$P(DATA,U,3),LRDATA=$G(^PXRM(810.4,LRIEN,0))
  1. .I FIRST W !!,?2,"List Rules:" S FIRST=0
  1. .W !,?2,SEQ,?7,$P(LRDATA,U),?66
  1. .W $S(ACT="A":"ADD PATIENT",ACT="R":"REMOVE PATIENT",ACT="F":"INSERT FINDING",1:"SELECT PATIENT")
  1. .;Display List Rule fields
  1. .D LROUT^PXRMLRED(LRIEN,23)
  1. .W !
  1. Q
  1. ;
  1. PPFR ;Display counting rules and count type
  1. ;used by [PXRM EXTRACT DEFINITION] template)
  1. W !
  1. N DATA,GIEN,GSTATUS,IEN,SEQ,SUB
  1. S IEN=$P(X,U,3) Q:'IEN
  1. S SEQ=""
  1. F S SEQ=$O(^PXRM(810.7,IEN,10,"B",SEQ)) Q:SEQ="" D
  1. .S SUB=$O(^PXRM(810.7,IEN,10,"B",SEQ,"")) Q:'SUB
  1. .S DATA=$G(^PXRM(810.7,IEN,10,SUB,0)) Q:DATA=""
  1. .S GIEN=$P(DATA,U,2) Q:GIEN=""
  1. .S GSTATUS=$P(DATA,U,3)
  1. .;Get counting groups
  1. .N CTYP,CTXT,DATA,EXCL,FIRST,GNAME,PNAME,TIEN,TNAME,GSEQ,GSUB
  1. .S DATA=$G(^PXRM(810.8,GIEN,0)),GNAME=$P(DATA,U)
  1. .S CTYP=$P(DATA,U,3),PNAME=$P(DATA,U,2),GSEQ="",FIRST=1
  1. .S CTXT=$$TXT(CTYP,GSTATUS)
  1. .F S GSEQ=$O(^PXRM(810.8,GIEN,10,"B",GSEQ)) Q:GSEQ="" D
  1. ..S GSUB=$O(^PXRM(810.8,GIEN,10,"B",GSEQ,"")) Q:'GSUB
  1. ..S DATA=$G(^PXRM(810.8,GIEN,10,GSUB,0)) Q:DATA=""
  1. ..S TIEN=$P(DATA,U,2) Q:TIEN=""
  1. ..S EXCL=$P(DATA,U,3) Q:EXCL="E"
  1. ..S TNAME=$P($G(^PXRMD(811.5,TIEN,0)),U)
  1. ..I FIRST D
  1. ...W !,?14,SEQ
  1. ...W ?18,"Counting Group: ",GNAME
  1. ...W !,?18,$$TXT(CTYP,GSTATUS)
  1. ...W !,?23,"Terms:" S FIRST=0
  1. ..W ?30,TNAME,!
  1. Q
  1. ;
  1. SCREEN ;Screen for 810.210 field .02
  1. S DIC("S")="I $P(^(0),U,3)=3"
  1. Q
  1. ;
  1. TXT(COUNT,COHORT) ;Text to describe group
  1. N TXT
  1. ;Determine count type
  1. I COUNT="MRFP" S TXT="Most recent finding patient counts for "
  1. I COUNT="MRF" S TXT="Most recent finding counts for "
  1. I COUNT="UR" S TXT="Utilization in period finding counts for "
  1. ;Error
  1. I $G(TXT)="" Q "Unknown count type - error"
  1. ;Determine cohort
  1. S TXT=TXT_$S(COHORT="A":"APPLICABLE",1:"TOTAL")_" patients"
  1. Q TXT