[628] | 1 | PXRMETX ; SLC/PJH - Run Extract for QUERI ;07/10/2007
|
---|
| 2 | ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123
|
---|
| 3 | ;
|
---|
| 4 | AUTO(ID,PURGE) ;Called from option scheduling (#19.2)
|
---|
| 5 | N IEN,LIST,LUVALUE,MODE,NEXT
|
---|
| 6 | S LUVALUE(1)=ID
|
---|
| 7 | D FIND^DIC(810.2,"","","U",.LUVALUE,"","","","","LIST")
|
---|
| 8 | ;Get ien of extract parameter
|
---|
| 9 | S IEN=$P(LIST("DILIST",2,1),U,1) Q:'IEN
|
---|
| 10 | ;Get next extract period
|
---|
| 11 | S NEXT=$P($G(^PXRM(810.2,IEN,0)),U,6) Q:NEXT=""
|
---|
| 12 | ;Node is Extract and Transmit
|
---|
| 13 | S MODE=$S($P($G(^PXRM(810.2,IEN,100)),U)="N":0,1:1)
|
---|
| 14 | ;Run extract
|
---|
| 15 | D RUN^PXRMETX(IEN,NEXT,MODE,PURGE)
|
---|
| 16 | ;Purge Extract Summary
|
---|
| 17 | D PRGES^PXRMETXU
|
---|
| 18 | ;Purge Patient Lists
|
---|
| 19 | D PRGPL^PXRMETXU
|
---|
| 20 | Q
|
---|
| 21 | ;
|
---|
| 22 | GETNAME(NAME,CLASS) ;Get the extract name.
|
---|
| 23 | I '$D(^PXRMXT(810.3,"B",NAME)) Q NAME
|
---|
| 24 | N CNT,NEW
|
---|
| 25 | S (CNT,NEW)=0
|
---|
| 26 | ;If name exists concatenate count
|
---|
| 27 | F D Q:NEW
|
---|
| 28 | .I '$D(^PXRMXT(810.3,"B",NAME)) S NEW=1 Q
|
---|
| 29 | .S CNT=CNT+1,NAME=$P(NAME,"/")_"/"_$$RJ^XLFSTR(CNT,2,0)
|
---|
| 30 | Q NAME
|
---|
| 31 | ;
|
---|
| 32 | IHD ;Monthly IHD Extract, called from option PXRM EXTRACT VA-IHD QUERI.
|
---|
| 33 | D AUTO("VA-IHD QUERI","Y")
|
---|
| 34 | Q
|
---|
| 35 | ;
|
---|
| 36 | MAIL(NAME,NEXT,MODE) ;Completion mail message
|
---|
| 37 | N FREQ,TEXT
|
---|
| 38 | S FREQ="year"
|
---|
| 39 | I $E(NEXT)="M" S FREQ="month"
|
---|
| 40 | I $E(NEXT)="Q" S FREQ="quarter"
|
---|
| 41 | ;
|
---|
| 42 | I MODE=0 S TEXT="Extract and Transmission"
|
---|
| 43 | I MODE=1 S TEXT="Extract (No Transmission)"
|
---|
| 44 | I MODE=2 S TEXT="Manual Extract and Transmission"
|
---|
| 45 | I MODE=3 S TEXT="Manual Extract (No Transmission)"
|
---|
| 46 | ;
|
---|
| 47 | S TEXT=NAME_" "_TEXT_" completed for "_FREQ_" "_NEXT
|
---|
| 48 | D MES^PXRMEUT(TEXT)
|
---|
| 49 | Q
|
---|
| 50 | ;
|
---|
| 51 | MH ;Monthly MH Extract, called from option PXRM EXTRACT VA-MH QUERI.
|
---|
| 52 | D AUTO("VA-MH QUERI","Y")
|
---|
| 53 | Q
|
---|
| 54 | ;
|
---|
| 55 | RUN(IEN,NEXT,MODE,PURGE) ;Process extract parameter
|
---|
| 56 | ; IEN is ien of Extract Parameter
|
---|
| 57 | ; NEXT is period to extract
|
---|
| 58 | ; MODE = 0 is extract and transmission
|
---|
| 59 | ; MODE = 1 is extract only
|
---|
| 60 | ; MODE = 2 is manual extract and transmission (doesn't update 810.2)
|
---|
| 61 | ; MODE = 3 is manual extract only (doesn't update 810.2)
|
---|
| 62 | ;
|
---|
| 63 | N CLASS,FDA,FDAIEN,MSG
|
---|
| 64 | N PXRMIDOD,PXRMLIST,PXRMNODE,PXRMRULE,PXRMSTRT,PXRMXIEN,PATCREAT,XNAME
|
---|
| 65 | N ITER
|
---|
| 66 | ;Initialise
|
---|
| 67 | K ^TMP("PXRMETX",$J),^TMP("PXRMETX1",$J)
|
---|
| 68 | ;Workfile node for ^TMP
|
---|
| 69 | S PXRMNODE="PXRMRULE"
|
---|
| 70 | ;Get details from parameter file
|
---|
| 71 | N DATA,INDP,INTP,LIST,NAME,PARTYPE,PERIOD,SNAME,TEXT,YEAR
|
---|
| 72 | ;Get class from extract parameter
|
---|
| 73 | S CLASS=$P($G(^PXRM(810.2,IEN,100)),U)
|
---|
| 74 | ;Otherwise default to local
|
---|
| 75 | I $G(CLASS)="" S CLASS="L"
|
---|
| 76 | ;
|
---|
| 77 | S DATA=$G(^PXRM(810.2,IEN,0))
|
---|
| 78 | ;Determine Extract Name and period
|
---|
| 79 | S NAME=$P(DATA,U),PARTYPE=$P(DATA,U,2)
|
---|
| 80 | S YEAR=$P(NEXT,"/",2),PERIOD=$P(NEXT,"/")
|
---|
| 81 | ;Calculate report period start and end dates
|
---|
| 82 | D CALC^PXRMEUT(NEXT,.PXRMSTRT,.PXRMSTOP)
|
---|
| 83 | ;Determine output name for patient list and extract summary
|
---|
| 84 | S XNAME=NAME_" "_YEAR_" "_PERIOD
|
---|
| 85 | S NAME=$$GETNAME(XNAME)
|
---|
| 86 | S ITER=$P(NAME,"/",2)
|
---|
| 87 | ;Process (single) Denominator rule into patient list
|
---|
| 88 | N SEQ,SUB
|
---|
| 89 | S SEQ=""
|
---|
| 90 | F S SEQ=$O(^PXRM(810.2,IEN,10,"B",SEQ)) Q:'SEQ D
|
---|
| 91 | .S SUB=$O(^PXRM(810.2,IEN,10,"B",SEQ,"")) Q:'SUB
|
---|
| 92 | .S DATA=$G(^PXRM(810.2,IEN,10,SUB,0)) Q:DATA=""
|
---|
| 93 | .S PXRMRULE=$P(DATA,U,2) Q:'PXRMRULE
|
---|
| 94 | .S LIST=$P(DATA,U,3) Q:LIST=""
|
---|
| 95 | .I LIST["yyyy" S LIST=$P(LIST,"yyyy")_YEAR_$P(LIST,"yyyy",2)
|
---|
| 96 | .I LIST["nn" S LIST=$P(LIST,"nn")_$E(PERIOD,2,10)_$P(LIST,"nn",2)
|
---|
| 97 | .S INDP=+$P(DATA,U,4)
|
---|
| 98 | .S INTP=+$P(DATA,U,5)
|
---|
| 99 | .;Create new patient list
|
---|
| 100 | .I ITER'="" S LIST=LIST_"/"_ITER
|
---|
| 101 | .S PATCREAT="Y",PXRMLIST=$$CRLST^PXRMRUL1(LIST,CLASS) Q:'PXRMLIST
|
---|
| 102 | .;
|
---|
| 103 | .D START^PXRMRULE(PXRMRULE,PXRMLIST,PXRMNODE,PXRMSTRT,PXRMSTOP,IEN,YEAR,PERIOD,INDP,INTP,ITER)
|
---|
| 104 | .;Clear ^TMP lists created for rule
|
---|
| 105 | .D CLEAR^PXRMRULE(PXRMRULE,PXRMNODE)
|
---|
| 106 | .;Process reminders and finding rules
|
---|
| 107 | .;If include deceased patients is true then set the flag so reminders
|
---|
| 108 | .;will be evaluated for deceased patients.
|
---|
| 109 | .S PXRMIDOD=$S(INDP:1,1:0)
|
---|
| 110 | .D REM^PXRMETXR(SUB,PXRMLIST,PXRMSTRT,PXRMSTOP,PARTYPE)
|
---|
| 111 | ;
|
---|
| 112 | ;Get the name
|
---|
| 113 | ;S NAME=$$GETNAME(XNAME)
|
---|
| 114 | ;Create extract summary entry
|
---|
| 115 | S FDA(810.3,"+1,",.01)=NAME
|
---|
| 116 | S FDA(810.3,"+1,",.02)=PXRMSTRT
|
---|
| 117 | S FDA(810.3,"+1,",.03)=PXRMSTOP
|
---|
| 118 | S FDA(810.3,"+1,",.06)=$$NOW^XLFDT
|
---|
| 119 | S FDA(810.3,"+1,",1)=IEN
|
---|
| 120 | S FDA(810.3,"+1,",2)=PARTYPE
|
---|
| 121 | S FDA(810.3,"+1,",3)=$E(PERIOD,2,99)
|
---|
| 122 | S FDA(810.3,"+1,",4)=YEAR
|
---|
| 123 | S FDA(810.3,"+1,",5)=$S(MODE<2:"A",1:"M")
|
---|
| 124 | S FDA(810.3,"+1,",7)=$E(PERIOD)
|
---|
| 125 | I PURGE="Y" S FDA(810.3,"+1,",50)=1
|
---|
| 126 | S FDA(810.3,"+1,",100)=CLASS
|
---|
| 127 | D UPDATE^DIE("","FDA","FDAIEN","MSG")
|
---|
| 128 | I $D(MSG) D AWRITE^PXRMUTIL("MSG") G EXIT
|
---|
| 129 | ;
|
---|
| 130 | ;Update extract summary from ^TMP
|
---|
| 131 | D UPDEX(FDAIEN(1))
|
---|
| 132 | ;
|
---|
| 133 | ;Transmit results
|
---|
| 134 | I (MODE=0)!(MODE=2) D TRANS(FDAIEN(1))
|
---|
| 135 | ;
|
---|
| 136 | ;Update extract parameters
|
---|
| 137 | I MODE<2 D UPDPAR
|
---|
| 138 | ;
|
---|
| 139 | ;Mail message that extract completed
|
---|
| 140 | D MAIL(NAME,NEXT,MODE)
|
---|
| 141 | ;
|
---|
| 142 | EXIT ;Clear workfile
|
---|
| 143 | K ^TMP("PXRMETX",$J),^TMP("PXRMETX1",$J)
|
---|
| 144 | Q
|
---|
| 145 | ;
|
---|
| 146 | TRANS(PXRMXIEN) ;Transmit HL7 messages
|
---|
| 147 | N HL7ID,NAME,NEXT
|
---|
| 148 | S HL7ID=""
|
---|
| 149 | D HL7^PXRM7API(PXRMXIEN,1,.HL7ID)
|
---|
| 150 | H 2
|
---|
| 151 | ;Lock extract summary
|
---|
| 152 | D LOCK(PXRMXIEN) Q:$D(DUOUT)
|
---|
| 153 | ;Update run information
|
---|
| 154 | S NAME=$P($G(^PXRMXT(810.3,PXRMXIEN,0)),U)
|
---|
| 155 | S NEXT=$P($G(^PXRMXT(810.3,PXRMXIEN,4)),U,3)
|
---|
| 156 | S FDA(810.3,"?1,",.01)=NAME
|
---|
| 157 | S FDA(810.36,"?+2,?1,",.01)=HL7ID
|
---|
| 158 | S FDA(810.36,"?+2,?1,",.02)=$$NOW^XLFDT
|
---|
| 159 | D UPDATE^DIE("","FDA","","MSG")
|
---|
| 160 | ;Unlock extract summary
|
---|
| 161 | D UNLOCK(PXRMXIEN)
|
---|
| 162 | Q
|
---|
| 163 | ;
|
---|
| 164 | UPDEX(IEN) ;Update extract summary
|
---|
| 165 | N DUOUT
|
---|
| 166 | ;Lock extract summary
|
---|
| 167 | D LOCK(IEN) Q:$D(DUOUT)
|
---|
| 168 | ;
|
---|
| 169 | ;Update totals section
|
---|
| 170 | N APPL,CNT,DFN,DUE,DATA,ETYP,EVAL
|
---|
| 171 | N FAPPL,FCNT,FDATA,FDUE,FEVAL,FGNAM,FGSTA,FIND,FNAPPL,FNDUE,FSEQ
|
---|
| 172 | N GDATA,GSEQ,INST,NAPPL,NDUE,PCNT,PXRMLIST,RCNT,RIEN,RSEQ,SEQ,TEMP
|
---|
| 173 | S SEQ="",CNT=1,RSEQ=0
|
---|
| 174 | F S SEQ=$O(^TMP("PXRMETX",$J,SEQ)) Q:SEQ="" D
|
---|
| 175 | .S INST=0
|
---|
| 176 | .F S INST=$O(^TMP("PXRMETX",$J,SEQ,INST)) Q:'INST D
|
---|
| 177 | ..S RCNT=""
|
---|
| 178 | ..F S RCNT=$O(^TMP("PXRMETX",$J,SEQ,INST,RCNT)) Q:RCNT="" D
|
---|
| 179 | ...S DATA=$G(^TMP("PXRMETX",$J,SEQ,INST,RCNT)) Q:'DATA
|
---|
| 180 | ...S RIEN=$P(DATA,U,1),EVAL=$P(DATA,U,2),APPL=$P(DATA,U,3)
|
---|
| 181 | ...S NAPPL=$P(DATA,U,4),DUE=$P(DATA,U,5),NDUE=$P(DATA,U,6)
|
---|
| 182 | ...S PXRMLIST=$P(DATA,U,7)
|
---|
| 183 | ...S CNT=CNT+1,RSEQ=RSEQ+1
|
---|
| 184 | ...S TEMP=$$RJ^XLFSTR(RSEQ,3,0)_U_RIEN_U_INST_U_PXRMLIST_U_EVAL_U_APPL_U_NAPPL_U_DUE_U_NDUE
|
---|
| 185 | ...S ^PXRMXT(810.3,IEN,3,RSEQ,0)=TEMP
|
---|
| 186 | ...S ^PXRMXT(810.3,IEN,3,"B",$P(TEMP,U,1),RSEQ)=""
|
---|
| 187 | ...;For each count type
|
---|
| 188 | ...S GSEQ="",FCNT=0
|
---|
| 189 | ...F S GSEQ=$O(^TMP("PXRMETX1",$J,SEQ,RCNT,GSEQ)) Q:GSEQ="" D
|
---|
| 190 | ....S GDATA=$G(^TMP("PXRMETX1",$J,SEQ,RCNT,GSEQ))
|
---|
| 191 | ....S FGNAM=$P(GDATA,U),ETYP=$P(GDATA,U,2),FGSTA=$P(GDATA,U,3)
|
---|
| 192 | ....;For each term
|
---|
| 193 | ....S FSEQ=0
|
---|
| 194 | ....F S FSEQ=$O(^TMP("PXRMETX1",$J,SEQ,RCNT,GSEQ,FSEQ)) Q:FSEQ="" D
|
---|
| 195 | .....;Get the term ien
|
---|
| 196 | .....S FIND=$P($G(^TMP("PXRMETX1",$J,SEQ,RCNT,GSEQ,FSEQ)),U),FCNT=FCNT+1
|
---|
| 197 | .....;Update finding totals
|
---|
| 198 | .....S FDATA=$G(^TMP("PXRMETX",$J,SEQ,INST,RCNT,GSEQ,FSEQ))
|
---|
| 199 | .....S FEVAL=$P(FDATA,U,2),FAPPL=$P(FDATA,U,3),FNAPPL=$P(FDATA,U,4)
|
---|
| 200 | .....S FDUE=$P(FDATA,U,5),FNDUE=$P(FDATA,U,6)
|
---|
| 201 | .....S TEMP=FSEQ_U_$P(FIND,";")_U_ETYP_U_FEVAL_U_FAPPL_U_FNAPPL_U_FDUE_U_FNDUE_U_FGNAM_U_FGSTA
|
---|
| 202 | .....S ^PXRMXT(810.3,IEN,3,RSEQ,1,FCNT,0)=TEMP
|
---|
| 203 | .....;
|
---|
| 204 | .....;AGP REMOVE UNTIL A DECISION CAN BE MADE
|
---|
| 205 | .....;S DFN=0,PCNT=0
|
---|
| 206 | .....;F S DFN=$O(^TMP("PXRMETX",$J,SEQ,INST,RCNT,GSEQ,FSEQ,DFN)) Q:DFN'>0 D
|
---|
| 207 | .....;.S PCNT=PCNT+1,^PXRMXT(810.3,IEN,3,RSEQ,1,FCNT,1,PCNT,0)=DFN
|
---|
| 208 | .....;I PCNT>0 S ^PXRMXT(810.3,IEN,3,RSEQ,1,FCNT,1,0)="^810.3316PA"_U_PCNT_U_PCNT
|
---|
| 209 | ....I FCNT>0 S ^PXRMXT(810.3,IEN,3,RSEQ,1,0)="^810.331I"_U_FCNT_U_FCNT
|
---|
| 210 | .I RSEQ>0 S ^PXRMXT(810.3,IEN,3,0)="^810.33I"_U_RSEQ_U_RSEQ
|
---|
| 211 | ;Unlock extract summary
|
---|
| 212 | D UNLOCK(IEN)
|
---|
| 213 | Q
|
---|
| 214 | ;
|
---|
| 215 | ;File locking
|
---|
| 216 | LOCK(PXRMXIEN) L +^PXRMXT(810.3,PXRMXIEN):0
|
---|
| 217 | I '$T W !!?5,"Another user is using this extract summary" S DUOUT=1
|
---|
| 218 | Q
|
---|
| 219 | ;
|
---|
| 220 | UNLOCK(PXRMXIEN) L -^PXRMXT(810.3,PXRMXIEN) Q
|
---|
| 221 | ;
|
---|
| 222 | UPDPAR ;Update parameters when run complete
|
---|
| 223 | N DATA,LAST,NEXT,PERIOD,TYPE,YEAR
|
---|
| 224 | S DATA=$G(^PXRM(810.2,IEN,0)),NEXT=$P(DATA,U,6),TYPE=$P(DATA,U,3)
|
---|
| 225 | ;Last run updated
|
---|
| 226 | S LAST=NEXT
|
---|
| 227 | ;Calculate next run
|
---|
| 228 | I TYPE="Y" S NEXT=NEXT+1
|
---|
| 229 | I "QM"[TYPE D
|
---|
| 230 | .N NUM
|
---|
| 231 | .S PERIOD=$P(NEXT,"/",1),YEAR=$P(NEXT,"/",2)
|
---|
| 232 | .S NUM=$P(PERIOD,TYPE,2)+1
|
---|
| 233 | .I TYPE="Q",NUM>4 S NUM=1,YEAR=YEAR+1
|
---|
| 234 | .I TYPE="M",NUM>12 S NUM=1,YEAR=YEAR+1
|
---|
| 235 | .S NEXT=TYPE_NUM_"/"_YEAR
|
---|
| 236 | ;Update last and next run fields
|
---|
| 237 | S $P(^PXRM(810.2,IEN,0),U,4,6)=LAST_U_$$NOW^XLFDT_U_NEXT
|
---|
| 238 | Q
|
---|
| 239 | ;
|
---|