[628] | 1 | PXRMEPM ; SLC/PKR/PJH - Extract Definition Management ;07/17/2007
|
---|
| 2 | ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123
|
---|
| 3 | ;
|
---|
| 4 | ;Main entry point for PXRM EXTRACT DEFINITIONS
|
---|
| 5 | START N PXRMDONE,VALMBCK,VALMCNT,VALMSG,X,XMZ,XQORM,XQORNOD
|
---|
| 6 | S X="IORESET"
|
---|
| 7 | D ENDR^%ZISS
|
---|
| 8 | S VALMCNT=0
|
---|
| 9 | D EN^VALM("PXRM EXTRACT DEFINITIONS")
|
---|
| 10 | Q
|
---|
| 11 | ;
|
---|
| 12 | BLDLIST ;Build workfile
|
---|
| 13 | K ^TMP("PXRMEPM",$J)
|
---|
| 14 | N IEN,IND,PLIST
|
---|
| 15 | D LIST^PXRMETM("PXRMEPM",.VALMCNT)
|
---|
| 16 | Q
|
---|
| 17 | ;
|
---|
| 18 | ENTRY ;Entry code
|
---|
| 19 | D BLDLIST,XQORM
|
---|
| 20 | Q
|
---|
| 21 | ;
|
---|
| 22 | EXIT ;Exit code
|
---|
| 23 | K ^TMP("PXRMEPM",$J)
|
---|
| 24 | K ^TMP("PXRMEPMH",$J)
|
---|
| 25 | D CLEAN^VALM10
|
---|
| 26 | D FULL^VALM1
|
---|
| 27 | S VALMBCK="Q"
|
---|
| 28 | Q
|
---|
| 29 | ;
|
---|
| 30 | HDR ; Header code
|
---|
| 31 | S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
|
---|
| 32 | Q
|
---|
| 33 | ;
|
---|
| 34 | HLP ;Help code
|
---|
| 35 | N ORU,ORUPRMT,SUB,XQORM
|
---|
| 36 | S SUB="PXRMEPMH"
|
---|
| 37 | D EN^VALM("PXRM EXTRACT HELP")
|
---|
| 38 | Q
|
---|
| 39 | ;
|
---|
| 40 | INIT ;Init
|
---|
| 41 | S VALMCNT=0
|
---|
| 42 | Q
|
---|
| 43 | ;
|
---|
| 44 | PEXIT ;PXRM EXCH MENU protocol exit code
|
---|
| 45 | S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
|
---|
| 46 | ;Reset after page up/down etc
|
---|
| 47 | D XQORM
|
---|
| 48 | Q
|
---|
| 49 | ;
|
---|
| 50 | XQORM S XQORM("#")=$O(^ORD(101,"B","PXRM EXTRACT DEFINITION SELECT ENTRY",0))_U_"1:"_VALMCNT
|
---|
| 51 | S XQORM("A")="Select Item: "
|
---|
| 52 | Q
|
---|
| 53 | ;
|
---|
| 54 | XSEL ;PXRM EXTRACT DEFINITION SELECT ENTRY validation
|
---|
| 55 | N SEL,IEN
|
---|
| 56 | S SEL=$P(XQORNOD(0),"=",2)
|
---|
| 57 | ;Remove trailing ,
|
---|
| 58 | I $E(SEL,$L(SEL))="," S SEL=$E(SEL,1,$L(SEL)-1)
|
---|
| 59 | ;Invalid selection
|
---|
| 60 | I SEL["," D Q
|
---|
| 61 | .W $C(7),!,"Only one item number allowed." H 2
|
---|
| 62 | .S VALMBCK="R"
|
---|
| 63 | I ('SEL)!(SEL>VALMCNT)!('$D(@VALMAR@("SEL",SEL))) D Q
|
---|
| 64 | .W $C(7),!,SEL_" is not a valid item number." H 2
|
---|
| 65 | .S VALMBCK="R"
|
---|
| 66 | ;
|
---|
| 67 | ;Get the list ien.
|
---|
| 68 | S IEN=^TMP("PXRMEPM",$J,"SEL",SEL)
|
---|
| 69 | ;Display/Edit Extract Definition
|
---|
| 70 | D START^PXRMEPED(IEN)
|
---|
| 71 | D BLDLIST
|
---|
| 72 | S VALMBCK="R"
|
---|
| 73 | Q
|
---|
| 74 | ;
|
---|
| 75 | HELP(CALL) ;General help text routine
|
---|
| 76 | N HTEXT
|
---|
| 77 | I CALL=1 D
|
---|
| 78 | .S HTEXT(1)="Select DE to display or edit a definition."
|
---|
| 79 | .S HTEXT(2)="Select ED to edit a definition"
|
---|
| 80 | D HELP^PXRMEUT(.HTEXT)
|
---|
| 81 | Q
|
---|
| 82 | ;
|
---|
| 83 | EPADD ;Add Rule Option
|
---|
| 84 | ;Reset Screen Mode
|
---|
| 85 | W IORESET
|
---|
| 86 | ;
|
---|
| 87 | ;Add Rule
|
---|
| 88 | D ADD^PXRMEPED
|
---|
| 89 | ;
|
---|
| 90 | ;Rebuild Workfile
|
---|
| 91 | D BLDLIST
|
---|
| 92 | S VALMBCK="R"
|
---|
| 93 | Q
|
---|
| 94 | ;
|
---|
| 95 | EPINQ ;Definition Inquiry - PXRM EXTRACT DEFINITION DISPLAY/EDIT entry
|
---|
| 96 | N IND,LRIEN,VALMY
|
---|
| 97 | D EN^VALM2(XQORNOD(0))
|
---|
| 98 | ;
|
---|
| 99 | ;If there is no list quit.
|
---|
| 100 | I '$D(VALMY) Q
|
---|
| 101 | S PXRMDONE=0
|
---|
| 102 | S IND=""
|
---|
| 103 | F S IND=$O(VALMY(IND)) Q:(+IND=0)!(PXRMDONE) D
|
---|
| 104 | .;Get the ien.
|
---|
| 105 | .S LRIEN=^TMP("PXRMEPM",$J,"SEL",IND)
|
---|
| 106 | .D START^PXRMEPED(LRIEN)
|
---|
| 107 | D BLDLIST
|
---|
| 108 | S VALMBCK="R"
|
---|
| 109 | Q
|
---|
| 110 | ;
|
---|
| 111 | PPLR ;Display rule set components
|
---|
| 112 | ;used by [PXRM EXTRACT DEFINITION] template)
|
---|
| 113 | N ACT,DATA,FIRST,IEN,LRDATA,LRIEN,SEQ,SUB
|
---|
| 114 | S IEN=$P(X,U,2) Q:'IEN
|
---|
| 115 | W !," Description: ",$P($G(^PXRM(810.4,IEN,0)),U,2)
|
---|
| 116 | S SEQ="",FIRST=1
|
---|
| 117 | F S SEQ=$O(^PXRM(810.4,IEN,30,"B",SEQ)) Q:'SEQ D
|
---|
| 118 | .S SUB=$O(^PXRM(810.4,IEN,30,"B",SEQ,"")) Q:'SUB
|
---|
| 119 | .S DATA=$G(^PXRM(810.4,IEN,30,SUB,0)) Q:DATA=""
|
---|
| 120 | .S LRIEN=$P(DATA,U,2) Q:LRIEN=""
|
---|
| 121 | .S ACT=$P(DATA,U,3),LRDATA=$G(^PXRM(810.4,LRIEN,0))
|
---|
| 122 | .I FIRST W !!,?2,"List Rules:" S FIRST=0
|
---|
| 123 | .W !,?2,SEQ,?7,$P(LRDATA,U),?66
|
---|
| 124 | .W $S(ACT="A":"ADD PATIENT",ACT="R":"REMOVE PATIENT",ACT="F":"INSERT FINDING",1:"SELECT PATIENT")
|
---|
| 125 | .;Display List Rule fields
|
---|
| 126 | .D LROUT^PXRMLRED(LRIEN,23)
|
---|
| 127 | .W !
|
---|
| 128 | Q
|
---|
| 129 | ;
|
---|
| 130 | PPFR ;Display counting rules and count type
|
---|
| 131 | ;used by [PXRM EXTRACT DEFINITION] template)
|
---|
| 132 | W !
|
---|
| 133 | N DATA,GIEN,GSTATUS,IEN,SEQ,SUB
|
---|
| 134 | S IEN=$P(X,U,3) Q:'IEN
|
---|
| 135 | S SEQ=""
|
---|
| 136 | F S SEQ=$O(^PXRM(810.7,IEN,10,"B",SEQ)) Q:SEQ="" D
|
---|
| 137 | .S SUB=$O(^PXRM(810.7,IEN,10,"B",SEQ,"")) Q:'SUB
|
---|
| 138 | .S DATA=$G(^PXRM(810.7,IEN,10,SUB,0)) Q:DATA=""
|
---|
| 139 | .S GIEN=$P(DATA,U,2) Q:GIEN=""
|
---|
| 140 | .S GSTATUS=$P(DATA,U,3)
|
---|
| 141 | .;Get counting groups
|
---|
| 142 | .N CTYP,CTXT,DATA,EXCL,FIRST,GNAME,PNAME,TIEN,TNAME,GSEQ,GSUB
|
---|
| 143 | .S DATA=$G(^PXRM(810.8,GIEN,0)),GNAME=$P(DATA,U)
|
---|
| 144 | .S CTYP=$P(DATA,U,3),PNAME=$P(DATA,U,2),GSEQ="",FIRST=1
|
---|
| 145 | .S CTXT=$$TXT(CTYP,GSTATUS)
|
---|
| 146 | .F S GSEQ=$O(^PXRM(810.8,GIEN,10,"B",GSEQ)) Q:GSEQ="" D
|
---|
| 147 | ..S GSUB=$O(^PXRM(810.8,GIEN,10,"B",GSEQ,"")) Q:'GSUB
|
---|
| 148 | ..S DATA=$G(^PXRM(810.8,GIEN,10,GSUB,0)) Q:DATA=""
|
---|
| 149 | ..S TIEN=$P(DATA,U,2) Q:TIEN=""
|
---|
| 150 | ..S EXCL=$P(DATA,U,3) Q:EXCL="E"
|
---|
| 151 | ..S TNAME=$P($G(^PXRMD(811.5,TIEN,0)),U)
|
---|
| 152 | ..I FIRST D
|
---|
| 153 | ...W !,?14,SEQ
|
---|
| 154 | ...W ?18,"Counting Group: ",GNAME
|
---|
| 155 | ...W !,?18,$$TXT(CTYP,GSTATUS)
|
---|
| 156 | ...W !,?23,"Terms:" S FIRST=0
|
---|
| 157 | ..W ?30,TNAME,!
|
---|
| 158 | Q
|
---|
| 159 | ;
|
---|
| 160 | SCREEN ;Screen for 810.210 field .02
|
---|
| 161 | S DIC("S")="I $P(^(0),U,3)=3"
|
---|
| 162 | Q
|
---|
| 163 | ;
|
---|
| 164 | TXT(COUNT,COHORT) ;Text to describe group
|
---|
| 165 | N TXT
|
---|
| 166 | ;Determine count type
|
---|
| 167 | I COUNT="MRFP" S TXT="Most recent finding patient counts for "
|
---|
| 168 | I COUNT="MRF" S TXT="Most recent finding counts for "
|
---|
| 169 | I COUNT="UR" S TXT="Utilization in period finding counts for "
|
---|
| 170 | ;Error
|
---|
| 171 | I $G(TXT)="" Q "Unknown count type - error"
|
---|
| 172 | ;Determine cohort
|
---|
| 173 | S TXT=TXT_$S(COHORT="A":"APPLICABLE",1:"TOTAL")_" patients"
|
---|
| 174 | Q TXT
|
---|