PXRMETX ; SLC/PJH - Run Extract for QUERI ;01/28/2013
;;2.0;CLINICAL REMINDERS;**4,6,26**;Feb 04, 2005;Build 404
;
AUTO(ID,PURGE) ;Called from option scheduling (#19.2)
N IEN,LIST,LUVALUE,MODE,NEXT
S LUVALUE(1)=ID
D FIND^DIC(810.2,"","","U",.LUVALUE,"","","","","LIST")
;Get ien of extract parameter
S IEN=$P(LIST("DILIST",2,1),U,1) Q:'IEN
;Get next extract period
S NEXT=$P($G(^PXRM(810.2,IEN,0)),U,6) Q:NEXT=""
;Node is Extract and Transmit
S MODE=$S($P($G(^PXRM(810.2,IEN,100)),U)="N":0,1:1)
;Run extract
D RUN^PXRMETX(IEN,NEXT,MODE,PURGE)
;Purge Extract Summary
D PRGES^PXRMETXU
;Purge Patient Lists
D PRGPL^PXRMETXU
Q
;
GETNAME(NAME,CLASS) ;Get the extract name.
I '$D(^PXRMXT(810.3,"B",NAME)) Q NAME
N CNT,NEW
S (CNT,NEW)=0
;If name exists concatenate count
F D Q:NEW
.I '$D(^PXRMXT(810.3,"B",NAME)) S NEW=1 Q
.S CNT=CNT+1,NAME=$P(NAME,"/")_"/"_$$RJ^XLFSTR(CNT,2,0)
Q NAME
;
IHD ;Monthly IHD Extract, called from option PXRM EXTRACT VA-IHD QUERI.
D AUTO("VA-IHD QUERI","Y")
Q
;
MAIL(NAME,NEXT,MODE) ;Completion mail message
N FREQ,TEXT
S FREQ="year"
I $E(NEXT)="M" S FREQ="month"
I $E(NEXT)="Q" S FREQ="quarter"
;
I MODE=0 S TEXT="Extract and Transmission"
I MODE=1 S TEXT="Extract (No Transmission)"
I MODE=2 S TEXT="Manual Extract and Transmission"
I MODE=3 S TEXT="Manual Extract (No Transmission)"
;
S TEXT=NAME_" "_TEXT_" completed for "_FREQ_" "_NEXT
D MES^PXRMEUT(TEXT)
Q
;
MH ;Monthly MH Extract, called from option PXRM EXTRACT VA-MH QUERI.
D AUTO("VA-MH QUERI","Y")
Q
;
RUN(IEN,NEXT,MODE,PURGE) ;Process extract parameter
; IEN is ien of Extract Parameter
; NEXT is period to extract
; MODE = 0 is extract and transmission
; MODE = 1 is extract only
; MODE = 2 is manual extract and transmission (doesn't update 810.2)
; MODE = 3 is manual extract only (doesn't update 810.2)
;
N CLASS,FDA,FDAIEN,MSG
N PXRMIDOD,PXRMLIST,PXRMNODE,PXRMRULE,PXRMSTRT,PXRMXIEN,PATCREAT,XNAME
N ITER
;Initialise
K ^TMP("PXRMETX",$J),^TMP("PXRMETX1",$J)
;Workfile node for ^TMP
S PXRMNODE="PXRMRULE"
;Get details from parameter file
N DATA,INDP,INTP,LIST,NAME,PARTYPE,PERIOD,SNAME,TEXT,YEAR
;Get class from extract parameter
S CLASS=$P($G(^PXRM(810.2,IEN,100)),U)
;Otherwise default to local
I $G(CLASS)="" S CLASS="L"
;
S DATA=$G(^PXRM(810.2,IEN,0))
;Determine Extract Name and period
S NAME=$P(DATA,U),PARTYPE=$P(DATA,U,2)
S YEAR=$P(NEXT,"/",2),PERIOD=$P(NEXT,"/")
;Calculate report period start and end dates
D CALC^PXRMEUT(NEXT,.PXRMSTRT,.PXRMSTOP)
;Determine output name for patient list and extract summary
S XNAME=NAME_" "_YEAR_" "_PERIOD
S NAME=$$GETNAME(XNAME)
S ITER=$P(NAME,"/",2)
;Process (single) Denominator rule into patient list
N SEQ,SUB
S SEQ=""
F S SEQ=$O(^PXRM(810.2,IEN,10,"B",SEQ)) Q:'SEQ D
.S SUB=$O(^PXRM(810.2,IEN,10,"B",SEQ,"")) Q:'SUB
.S DATA=$G(^PXRM(810.2,IEN,10,SUB,0)) Q:DATA=""
.S PXRMRULE=$P(DATA,U,2) Q:'PXRMRULE
.S LIST=$P(DATA,U,3) Q:LIST=""
.I LIST["yyyy" S LIST=$P(LIST,"yyyy")_YEAR_$P(LIST,"yyyy",2)
.I LIST["nn" S LIST=$P(LIST,"nn")_$E(PERIOD,2,10)_$P(LIST,"nn",2)
.S INDP=+$P(DATA,U,4)
.S INTP=+$P(DATA,U,5)
.;Create new patient list
.I ITER'="" S LIST=LIST_"/"_ITER
.S PATCREAT="Y",PXRMLIST=$$CRLST^PXRMRUL1(LIST,CLASS) Q:'PXRMLIST
.;
.D START^PXRMRULE(PXRMRULE,PXRMLIST,PXRMNODE,PXRMSTRT,PXRMSTOP,IEN,YEAR,PERIOD,INDP,INTP,ITER)
.;Clear ^TMP lists created for rule
.D CLEAR^PXRMRULE(PXRMRULE,PXRMNODE)
.;Process reminders and finding rules
.;If include deceased patients is true then set the flag so reminders
.;will be evaluated for deceased patients.
.S PXRMIDOD=$S(INDP:1,1:0)
.D REM^PXRMETXR(SUB,PXRMLIST,PXRMSTRT,PXRMSTOP,PARTYPE)
;
;Get the name
;S NAME=$$GETNAME(XNAME)
;Create extract summary entry
S FDA(810.3,"+1,",.01)=NAME
S FDA(810.3,"+1,",.02)=PXRMSTRT
S FDA(810.3,"+1,",.03)=PXRMSTOP
S FDA(810.3,"+1,",.06)=$$NOW^XLFDT
S FDA(810.3,"+1,",1)=IEN
S FDA(810.3,"+1,",2)=PARTYPE
S FDA(810.3,"+1,",3)=$E(PERIOD,2,99)
S FDA(810.3,"+1,",4)=YEAR
S FDA(810.3,"+1,",5)=$S(MODE<2:"A",1:"M")
S FDA(810.3,"+1,",7)=$E(PERIOD)
I PURGE="Y" S FDA(810.3,"+1,",50)=1
S FDA(810.3,"+1,",100)=CLASS
D UPDATE^DIE("","FDA","FDAIEN","MSG")
I $D(MSG) D AWRITE^PXRMUTIL("MSG") G EXIT
;
;Update extract summary from ^TMP
D UPDEX(FDAIEN(1))
;
;Transmit results
I (MODE=0)!(MODE=2) D TRANS(FDAIEN(1))
;
;Update extract parameters
I MODE<2 D UPDPAR
;
;Mail message that extract completed
D MAIL(NAME,NEXT,MODE)
;
EXIT ;Clear workfile
K ^TMP("PXRMETX",$J),^TMP("PXRMETX1",$J)
Q
;
TRANS(PXRMXIEN) ;Transmit HL7 messages
N HL7ID,NAME,NEXT
S HL7ID=""
D HL7^PXRM7API(PXRMXIEN,1,.HL7ID)
H 2
;Lock extract summary
D LOCK(PXRMXIEN) Q:$D(DUOUT)
;Update run information
S NAME=$P($G(^PXRMXT(810.3,PXRMXIEN,0)),U)
S NEXT=$P($G(^PXRMXT(810.3,PXRMXIEN,4)),U,3)
S FDA(810.3,"?1,",.01)=NAME
S FDA(810.36,"?+2,?1,",.01)=HL7ID
S FDA(810.36,"?+2,?1,",.02)=$$NOW^XLFDT
D UPDATE^DIE("","FDA","","MSG")
;Unlock extract summary
D UNLOCK(PXRMXIEN)
Q
;
UPDEX(IEN) ;Update extract summary
N DUOUT
;Lock extract summary
D LOCK(IEN) Q:$D(DUOUT)
;
;Update totals section
N APPL,CNT,DFN,DUE,DATA,ETYP,EVAL
N FAPPL,FCNT,FDATA,FDUE,FEVAL,FGNAM,FGSTA,FIND,FNAPPL,FNDUE,FSEQ
N GDATA,GSEQ,INST,NAPPL,NDUE,PCNT,PXRMLIST,RCNT,RIEN,RSEQ,SEQ,TEMP
S SEQ="",CNT=1,RSEQ=0
F S SEQ=$O(^TMP("PXRMETX",$J,SEQ)) Q:SEQ="" D
.S INST=0
.F S INST=$O(^TMP("PXRMETX",$J,SEQ,INST)) Q:'INST D
..S RCNT=""
..F S RCNT=$O(^TMP("PXRMETX",$J,SEQ,INST,RCNT)) Q:RCNT="" D
...S DATA=$G(^TMP("PXRMETX",$J,SEQ,INST,RCNT)) Q:'DATA
...S RIEN=$P(DATA,U,1),EVAL=$P(DATA,U,2),APPL=$P(DATA,U,3)
...S NAPPL=$P(DATA,U,4),DUE=$P(DATA,U,5),NDUE=$P(DATA,U,6)
...S PXRMLIST=$P(DATA,U,7)
...S CNT=CNT+1,RSEQ=RSEQ+1
...S TEMP=$$RJ^XLFSTR(RSEQ,3,0)_U_RIEN_U_INST_U_PXRMLIST_U_EVAL_U_APPL_U_NAPPL_U_DUE_U_NDUE
...S ^PXRMXT(810.3,IEN,3,RSEQ,0)=TEMP
...S ^PXRMXT(810.3,IEN,3,"B",$P(TEMP,U,1),RSEQ)=""
...;For each count type
...S GSEQ="",FCNT=0
...F S GSEQ=$O(^TMP("PXRMETX1",$J,SEQ,RCNT,GSEQ)) Q:GSEQ="" D
....S GDATA=$G(^TMP("PXRMETX1",$J,SEQ,RCNT,GSEQ))
....S FGNAM=$P(GDATA,U),ETYP=$P(GDATA,U,2),FGSTA=$P(GDATA,U,3)
....;For each term
....S FSEQ=0
....F S FSEQ=$O(^TMP("PXRMETX1",$J,SEQ,RCNT,GSEQ,FSEQ)) Q:FSEQ="" D
.....;Get the term ien
.....S FIND=$P($G(^TMP("PXRMETX1",$J,SEQ,RCNT,GSEQ,FSEQ)),U),FCNT=FCNT+1
.....;Update finding totals
.....S FDATA=$G(^TMP("PXRMETX",$J,SEQ,INST,RCNT,GSEQ,FSEQ))
.....S FEVAL=$P(FDATA,U,2),FAPPL=$P(FDATA,U,3),FNAPPL=$P(FDATA,U,4)
.....S FDUE=$P(FDATA,U,5),FNDUE=$P(FDATA,U,6)
.....S TEMP=FSEQ_U_$P(FIND,";")_U_ETYP_U_FEVAL_U_FAPPL_U_FNAPPL_U_FDUE_U_FNDUE_U_FGNAM_U_FGSTA
.....S ^PXRMXT(810.3,IEN,3,RSEQ,1,FCNT,0)=TEMP
.....;
.....;AGP REMOVE UNTIL A DECISION CAN BE MADE
.....;S DFN=0,PCNT=0
.....;F S DFN=$O(^TMP("PXRMETX",$J,SEQ,INST,RCNT,GSEQ,FSEQ,DFN)) Q:DFN'>0 D
.....;.S PCNT=PCNT+1,^PXRMXT(810.3,IEN,3,RSEQ,1,FCNT,1,PCNT,0)=DFN
.....;I PCNT>0 S ^PXRMXT(810.3,IEN,3,RSEQ,1,FCNT,1,0)="^810.3316PA"_U_PCNT_U_PCNT
....I FCNT>0 S ^PXRMXT(810.3,IEN,3,RSEQ,1,0)="^810.331I"_U_FCNT_U_FCNT
.I RSEQ>0 S ^PXRMXT(810.3,IEN,3,0)="^810.33I"_U_RSEQ_U_RSEQ
;Unlock extract summary
D UNLOCK(IEN)
Q
;
;File locking
LOCK(PXRMXIEN) L +^PXRMXT(810.3,PXRMXIEN):DILOCKTM
I '$T W !!?5,"Another user is using this extract summary" S DUOUT=1
Q
;
UNLOCK(PXRMXIEN) L -^PXRMXT(810.3,PXRMXIEN) Q
;
UPDPAR ;Update parameters when run complete
N DATA,LAST,NEXT,PERIOD,TYPE,YEAR
S DATA=$G(^PXRM(810.2,IEN,0)),NEXT=$P(DATA,U,6),TYPE=$P(DATA,U,3)
;Last run updated
S LAST=NEXT
;Calculate next run
I TYPE="Y" S NEXT=NEXT+1
I "QM"[TYPE D
.N NUM
.S PERIOD=$P(NEXT,"/",1),YEAR=$P(NEXT,"/",2)
.S NUM=$P(PERIOD,TYPE,2)+1
.I TYPE="Q",NUM>4 S NUM=1,YEAR=YEAR+1
.I TYPE="M",NUM>12 S NUM=1,YEAR=YEAR+1
.S NEXT=TYPE_NUM_"/"_YEAR
;Update last and next run fields
S $P(^PXRM(810.2,IEN,0),U,4,6)=LAST_U_$$NOW^XLFDT_U_NEXT
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMETX 8144 printed Sep 15, 2024@21:08:55 Page 2
PXRMETX ; SLC/PJH - Run Extract for QUERI ;01/28/2013
+1 ;;2.0;CLINICAL REMINDERS;**4,6,26**;Feb 04, 2005;Build 404
+2 ;
AUTO(ID,PURGE) ;Called from option scheduling (#19.2)
+1 NEW IEN,LIST,LUVALUE,MODE,NEXT
+2 SET LUVALUE(1)=ID
+3 DO FIND^DIC(810.2,"","","U",.LUVALUE,"","","","","LIST")
+4 ;Get ien of extract parameter
+5 SET IEN=$PIECE(LIST("DILIST",2,1),U,1)
if 'IEN
QUIT
+6 ;Get next extract period
+7 SET NEXT=$PIECE($GET(^PXRM(810.2,IEN,0)),U,6)
if NEXT=""
QUIT
+8 ;Node is Extract and Transmit
+9 SET MODE=$SELECT($PIECE($GET(^PXRM(810.2,IEN,100)),U)="N":0,1:1)
+10 ;Run extract
+11 DO RUN^PXRMETX(IEN,NEXT,MODE,PURGE)
+12 ;Purge Extract Summary
+13 DO PRGES^PXRMETXU
+14 ;Purge Patient Lists
+15 DO PRGPL^PXRMETXU
+16 QUIT
+17 ;
GETNAME(NAME,CLASS) ;Get the extract name.
+1 IF '$DATA(^PXRMXT(810.3,"B",NAME))
QUIT NAME
+2 NEW CNT,NEW
+3 SET (CNT,NEW)=0
+4 ;If name exists concatenate count
+5 FOR
Begin DoDot:1
+6 IF '$DATA(^PXRMXT(810.3,"B",NAME))
SET NEW=1
QUIT
+7 SET CNT=CNT+1
SET NAME=$PIECE(NAME,"/")_"/"_$$RJ^XLFSTR(CNT,2,0)
End DoDot:1
if NEW
QUIT
+8 QUIT NAME
+9 ;
IHD ;Monthly IHD Extract, called from option PXRM EXTRACT VA-IHD QUERI.
+1 DO AUTO("VA-IHD QUERI","Y")
+2 QUIT
+3 ;
MAIL(NAME,NEXT,MODE) ;Completion mail message
+1 NEW FREQ,TEXT
+2 SET FREQ="year"
+3 IF $EXTRACT(NEXT)="M"
SET FREQ="month"
+4 IF $EXTRACT(NEXT)="Q"
SET FREQ="quarter"
+5 ;
+6 IF MODE=0
SET TEXT="Extract and Transmission"
+7 IF MODE=1
SET TEXT="Extract (No Transmission)"
+8 IF MODE=2
SET TEXT="Manual Extract and Transmission"
+9 IF MODE=3
SET TEXT="Manual Extract (No Transmission)"
+10 ;
+11 SET TEXT=NAME_" "_TEXT_" completed for "_FREQ_" "_NEXT
+12 DO MES^PXRMEUT(TEXT)
+13 QUIT
+14 ;
MH ;Monthly MH Extract, called from option PXRM EXTRACT VA-MH QUERI.
+1 DO AUTO("VA-MH QUERI","Y")
+2 QUIT
+3 ;
RUN(IEN,NEXT,MODE,PURGE) ;Process extract parameter
+1 ; IEN is ien of Extract Parameter
+2 ; NEXT is period to extract
+3 ; MODE = 0 is extract and transmission
+4 ; MODE = 1 is extract only
+5 ; MODE = 2 is manual extract and transmission (doesn't update 810.2)
+6 ; MODE = 3 is manual extract only (doesn't update 810.2)
+7 ;
+8 NEW CLASS,FDA,FDAIEN,MSG
+9 NEW PXRMIDOD,PXRMLIST,PXRMNODE,PXRMRULE,PXRMSTRT,PXRMXIEN,PATCREAT,XNAME
+10 NEW ITER
+11 ;Initialise
+12 KILL ^TMP("PXRMETX",$JOB),^TMP("PXRMETX1",$JOB)
+13 ;Workfile node for ^TMP
+14 SET PXRMNODE="PXRMRULE"
+15 ;Get details from parameter file
+16 NEW DATA,INDP,INTP,LIST,NAME,PARTYPE,PERIOD,SNAME,TEXT,YEAR
+17 ;Get class from extract parameter
+18 SET CLASS=$PIECE($GET(^PXRM(810.2,IEN,100)),U)
+19 ;Otherwise default to local
+20 IF $GET(CLASS)=""
SET CLASS="L"
+21 ;
+22 SET DATA=$GET(^PXRM(810.2,IEN,0))
+23 ;Determine Extract Name and period
+24 SET NAME=$PIECE(DATA,U)
SET PARTYPE=$PIECE(DATA,U,2)
+25 SET YEAR=$PIECE(NEXT,"/",2)
SET PERIOD=$PIECE(NEXT,"/")
+26 ;Calculate report period start and end dates
+27 DO CALC^PXRMEUT(NEXT,.PXRMSTRT,.PXRMSTOP)
+28 ;Determine output name for patient list and extract summary
+29 SET XNAME=NAME_" "_YEAR_" "_PERIOD
+30 SET NAME=$$GETNAME(XNAME)
+31 SET ITER=$PIECE(NAME,"/",2)
+32 ;Process (single) Denominator rule into patient list
+33 NEW SEQ,SUB
+34 SET SEQ=""
+35 FOR
SET SEQ=$ORDER(^PXRM(810.2,IEN,10,"B",SEQ))
if 'SEQ
QUIT
Begin DoDot:1
+36 SET SUB=$ORDER(^PXRM(810.2,IEN,10,"B",SEQ,""))
if 'SUB
QUIT
+37 SET DATA=$GET(^PXRM(810.2,IEN,10,SUB,0))
if DATA=""
QUIT
+38 SET PXRMRULE=$PIECE(DATA,U,2)
if 'PXRMRULE
QUIT
+39 SET LIST=$PIECE(DATA,U,3)
if LIST=""
QUIT
+40 IF LIST["yyyy"
SET LIST=$PIECE(LIST,"yyyy")_YEAR_$PIECE(LIST,"yyyy",2)
+41 IF LIST["nn"
SET LIST=$PIECE(LIST,"nn")_$EXTRACT(PERIOD,2,10)_$PIECE(LIST,"nn",2)
+42 SET INDP=+$PIECE(DATA,U,4)
+43 SET INTP=+$PIECE(DATA,U,5)
+44 ;Create new patient list
+45 IF ITER'=""
SET LIST=LIST_"/"_ITER
+46 SET PATCREAT="Y"
SET PXRMLIST=$$CRLST^PXRMRUL1(LIST,CLASS)
if 'PXRMLIST
QUIT
+47 ;
+48 DO START^PXRMRULE(PXRMRULE,PXRMLIST,PXRMNODE,PXRMSTRT,PXRMSTOP,IEN,YEAR,PERIOD,INDP,INTP,ITER)
+49 ;Clear ^TMP lists created for rule
+50 DO CLEAR^PXRMRULE(PXRMRULE,PXRMNODE)
+51 ;Process reminders and finding rules
+52 ;If include deceased patients is true then set the flag so reminders
+53 ;will be evaluated for deceased patients.
+54 SET PXRMIDOD=$SELECT(INDP:1,1:0)
+55 DO REM^PXRMETXR(SUB,PXRMLIST,PXRMSTRT,PXRMSTOP,PARTYPE)
End DoDot:1
+56 ;
+57 ;Get the name
+58 ;S NAME=$$GETNAME(XNAME)
+59 ;Create extract summary entry
+60 SET FDA(810.3,"+1,",.01)=NAME
+61 SET FDA(810.3,"+1,",.02)=PXRMSTRT
+62 SET FDA(810.3,"+1,",.03)=PXRMSTOP
+63 SET FDA(810.3,"+1,",.06)=$$NOW^XLFDT
+64 SET FDA(810.3,"+1,",1)=IEN
+65 SET FDA(810.3,"+1,",2)=PARTYPE
+66 SET FDA(810.3,"+1,",3)=$EXTRACT(PERIOD,2,99)
+67 SET FDA(810.3,"+1,",4)=YEAR
+68 SET FDA(810.3,"+1,",5)=$SELECT(MODE<2:"A",1:"M")
+69 SET FDA(810.3,"+1,",7)=$EXTRACT(PERIOD)
+70 IF PURGE="Y"
SET FDA(810.3,"+1,",50)=1
+71 SET FDA(810.3,"+1,",100)=CLASS
+72 DO UPDATE^DIE("","FDA","FDAIEN","MSG")
+73 IF $DATA(MSG)
DO AWRITE^PXRMUTIL("MSG")
GOTO EXIT
+74 ;
+75 ;Update extract summary from ^TMP
+76 DO UPDEX(FDAIEN(1))
+77 ;
+78 ;Transmit results
+79 IF (MODE=0)!(MODE=2)
DO TRANS(FDAIEN(1))
+80 ;
+81 ;Update extract parameters
+82 IF MODE<2
DO UPDPAR
+83 ;
+84 ;Mail message that extract completed
+85 DO MAIL(NAME,NEXT,MODE)
+86 ;
EXIT ;Clear workfile
+1 KILL ^TMP("PXRMETX",$JOB),^TMP("PXRMETX1",$JOB)
+2 QUIT
+3 ;
TRANS(PXRMXIEN) ;Transmit HL7 messages
+1 NEW HL7ID,NAME,NEXT
+2 SET HL7ID=""
+3 DO HL7^PXRM7API(PXRMXIEN,1,.HL7ID)
+4 HANG 2
+5 ;Lock extract summary
+6 DO LOCK(PXRMXIEN)
if $DATA(DUOUT)
QUIT
+7 ;Update run information
+8 SET NAME=$PIECE($GET(^PXRMXT(810.3,PXRMXIEN,0)),U)
+9 SET NEXT=$PIECE($GET(^PXRMXT(810.3,PXRMXIEN,4)),U,3)
+10 SET FDA(810.3,"?1,",.01)=NAME
+11 SET FDA(810.36,"?+2,?1,",.01)=HL7ID
+12 SET FDA(810.36,"?+2,?1,",.02)=$$NOW^XLFDT
+13 DO UPDATE^DIE("","FDA","","MSG")
+14 ;Unlock extract summary
+15 DO UNLOCK(PXRMXIEN)
+16 QUIT
+17 ;
UPDEX(IEN) ;Update extract summary
+1 NEW DUOUT
+2 ;Lock extract summary
+3 DO LOCK(IEN)
if $DATA(DUOUT)
QUIT
+4 ;
+5 ;Update totals section
+6 NEW APPL,CNT,DFN,DUE,DATA,ETYP,EVAL
+7 NEW FAPPL,FCNT,FDATA,FDUE,FEVAL,FGNAM,FGSTA,FIND,FNAPPL,FNDUE,FSEQ
+8 NEW GDATA,GSEQ,INST,NAPPL,NDUE,PCNT,PXRMLIST,RCNT,RIEN,RSEQ,SEQ,TEMP
+9 SET SEQ=""
SET CNT=1
SET RSEQ=0
+10 FOR
SET SEQ=$ORDER(^TMP("PXRMETX",$JOB,SEQ))
if SEQ=""
QUIT
Begin DoDot:1
+11 SET INST=0
+12 FOR
SET INST=$ORDER(^TMP("PXRMETX",$JOB,SEQ,INST))
if 'INST
QUIT
Begin DoDot:2
+13 SET RCNT=""
+14 FOR
SET RCNT=$ORDER(^TMP("PXRMETX",$JOB,SEQ,INST,RCNT))
if RCNT=""
QUIT
Begin DoDot:3
+15 SET DATA=$GET(^TMP("PXRMETX",$JOB,SEQ,INST,RCNT))
if 'DATA
QUIT
+16 SET RIEN=$PIECE(DATA,U,1)
SET EVAL=$PIECE(DATA,U,2)
SET APPL=$PIECE(DATA,U,3)
+17 SET NAPPL=$PIECE(DATA,U,4)
SET DUE=$PIECE(DATA,U,5)
SET NDUE=$PIECE(DATA,U,6)
+18 SET PXRMLIST=$PIECE(DATA,U,7)
+19 SET CNT=CNT+1
SET RSEQ=RSEQ+1
+20 SET TEMP=$$RJ^XLFSTR(RSEQ,3,0)_U_RIEN_U_INST_U_PXRMLIST_U_EVAL_U_APPL_U_NAPPL_U_DUE_U_NDUE
+21 SET ^PXRMXT(810.3,IEN,3,RSEQ,0)=TEMP
+22 SET ^PXRMXT(810.3,IEN,3,"B",$PIECE(TEMP,U,1),RSEQ)=""
+23 ;For each count type
+24 SET GSEQ=""
SET FCNT=0
+25 FOR
SET GSEQ=$ORDER(^TMP("PXRMETX1",$JOB,SEQ,RCNT,GSEQ))
if GSEQ=""
QUIT
Begin DoDot:4
+26 SET GDATA=$GET(^TMP("PXRMETX1",$JOB,SEQ,RCNT,GSEQ))
+27 SET FGNAM=$PIECE(GDATA,U)
SET ETYP=$PIECE(GDATA,U,2)
SET FGSTA=$PIECE(GDATA,U,3)
+28 ;For each term
+29 SET FSEQ=0
+30 FOR
SET FSEQ=$ORDER(^TMP("PXRMETX1",$JOB,SEQ,RCNT,GSEQ,FSEQ))
if FSEQ=""
QUIT
Begin DoDot:5
+31 ;Get the term ien
+32 SET FIND=$PIECE($GET(^TMP("PXRMETX1",$JOB,SEQ,RCNT,GSEQ,FSEQ)),U)
SET FCNT=FCNT+1
+33 ;Update finding totals
+34 SET FDATA=$GET(^TMP("PXRMETX",$JOB,SEQ,INST,RCNT,GSEQ,FSEQ))
+35 SET FEVAL=$PIECE(FDATA,U,2)
SET FAPPL=$PIECE(FDATA,U,3)
SET FNAPPL=$PIECE(FDATA,U,4)
+36 SET FDUE=$PIECE(FDATA,U,5)
SET FNDUE=$PIECE(FDATA,U,6)
+37 SET TEMP=FSEQ_U_$PIECE(FIND,";")_U_ETYP_U_FEVAL_U_FAPPL_U_FNAPPL_U_FDUE_U_FNDUE_U_FGNAM_U_FGSTA
+38 SET ^PXRMXT(810.3,IEN,3,RSEQ,1,FCNT,0)=TEMP
+39 ;
+40 ;AGP REMOVE UNTIL A DECISION CAN BE MADE
+41 ;S DFN=0,PCNT=0
+42 ;F S DFN=$O(^TMP("PXRMETX",$J,SEQ,INST,RCNT,GSEQ,FSEQ,DFN)) Q:DFN'>0 D
+43 ;.S PCNT=PCNT+1,^PXRMXT(810.3,IEN,3,RSEQ,1,FCNT,1,PCNT,0)=DFN
+44 ;I PCNT>0 S ^PXRMXT(810.3,IEN,3,RSEQ,1,FCNT,1,0)="^810.3316PA"_U_PCNT_U_PCNT
End DoDot:5
+45 IF FCNT>0
SET ^PXRMXT(810.3,IEN,3,RSEQ,1,0)="^810.331I"_U_FCNT_U_FCNT
End DoDot:4
End DoDot:3
End DoDot:2
+46 IF RSEQ>0
SET ^PXRMXT(810.3,IEN,3,0)="^810.33I"_U_RSEQ_U_RSEQ
End DoDot:1
+47 ;Unlock extract summary
+48 DO UNLOCK(IEN)
+49 QUIT
+50 ;
+51 ;File locking
LOCK(PXRMXIEN) LOCK +^PXRMXT(810.3,PXRMXIEN):DILOCKTM
+1 IF '$TEST
WRITE !!?5,"Another user is using this extract summary"
SET DUOUT=1
+2 QUIT
+3 ;
UNLOCK(PXRMXIEN) LOCK -^PXRMXT(810.3,PXRMXIEN)
QUIT
+1 ;
UPDPAR ;Update parameters when run complete
+1 NEW DATA,LAST,NEXT,PERIOD,TYPE,YEAR
+2 SET DATA=$GET(^PXRM(810.2,IEN,0))
SET NEXT=$PIECE(DATA,U,6)
SET TYPE=$PIECE(DATA,U,3)
+3 ;Last run updated
+4 SET LAST=NEXT
+5 ;Calculate next run
+6 IF TYPE="Y"
SET NEXT=NEXT+1
+7 IF "QM"[TYPE
Begin DoDot:1
+8 NEW NUM
+9 SET PERIOD=$PIECE(NEXT,"/",1)
SET YEAR=$PIECE(NEXT,"/",2)
+10 SET NUM=$PIECE(PERIOD,TYPE,2)+1
+11 IF TYPE="Q"
IF NUM>4
SET NUM=1
SET YEAR=YEAR+1
+12 IF TYPE="M"
IF NUM>12
SET NUM=1
SET YEAR=YEAR+1
+13 SET NEXT=TYPE_NUM_"/"_YEAR
End DoDot:1
+14 ;Update last and next run fields
+15 SET $PIECE(^PXRM(810.2,IEN,0),U,4,6)=LAST_U_$$NOW^XLFDT_U_NEXT
+16 QUIT
+17 ;