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

PXRMETX.m

Go to the documentation of this file. 
  1. PXRMETX ; SLC/PJH - Run Extract for QUERI ;01/28/2013
  1.  ;;2.0;CLINICAL REMINDERS;**4,6,26**;Feb 04, 2005;Build 404
  1.  ;
  1. AUTO(ID,PURGE) ;Called from option scheduling (#19.2)
  1.  N IEN,LIST,LUVALUE,MODE,NEXT
  1.  S LUVALUE(1)=ID
  1.  D FIND^DIC(810.2,"","","U",.LUVALUE,"","","","","LIST")
  1.  ;Get ien of extract parameter
  1.  S IEN=$P(LIST("DILIST",2,1),U,1) Q:'IEN
  1.  ;Get next extract period
  1.  S NEXT=$P($G(^PXRM(810.2,IEN,0)),U,6) Q:NEXT=""
  1.  ;Node is Extract and Transmit
  1.  S MODE=$S($P($G(^PXRM(810.2,IEN,100)),U)="N":0,1:1)
  1.  ;Run extract
  1.  D RUN^PXRMETX(IEN,NEXT,MODE,PURGE)
  1.  ;Purge Extract Summary
  1.  D PRGES^PXRMETXU
  1.  ;Purge Patient Lists
  1.  D PRGPL^PXRMETXU
  1.  Q
  1.  ;
  1. GETNAME(NAME,CLASS) ;Get the extract name.
  1.  I '$D(^PXRMXT(810.3,"B",NAME)) Q NAME
  1.  N CNT,NEW
  1.  S (CNT,NEW)=0
  1.  ;If name exists concatenate count
  1.  F  D  Q:NEW
  1.  .I '$D(^PXRMXT(810.3,"B",NAME)) S NEW=1 Q
  1.  .S CNT=CNT+1,NAME=$P(NAME,"/")_"/"_$$RJ^XLFSTR(CNT,2,0)
  1.  Q NAME
  1.  ;
  1. IHD ;Monthly IHD Extract, called from option PXRM EXTRACT VA-IHD QUERI.
  1.  D AUTO("VA-IHD QUERI","Y")
  1.  Q
  1.  ;
  1. MAIL(NAME,NEXT,MODE) ;Completion mail message
  1.  N FREQ,TEXT
  1.  S FREQ="year"
  1.  I $E(NEXT)="M" S FREQ="month"
  1.  I $E(NEXT)="Q" S FREQ="quarter"
  1.  ;
  1.  I MODE=0 S TEXT="Extract and Transmission"
  1.  I MODE=1 S TEXT="Extract (No Transmission)"
  1.  I MODE=2 S TEXT="Manual Extract and Transmission"
  1.  I MODE=3 S TEXT="Manual Extract (No Transmission)"
  1.  ;
  1.  S TEXT=NAME_" "_TEXT_" completed for "_FREQ_" "_NEXT
  1.  D MES^PXRMEUT(TEXT)
  1.  Q
  1.  ;
  1. MH ;Monthly MH Extract, called from option PXRM EXTRACT VA-MH QUERI.
  1.  D AUTO("VA-MH QUERI","Y")
  1.  Q
  1.  ;
  1. RUN(IEN,NEXT,MODE,PURGE) ;Process extract parameter
  1.  ; IEN is ien of Extract Parameter
  1.  ; NEXT is period to extract
  1.  ; MODE = 0 is extract and transmission
  1.  ; MODE = 1 is extract only
  1.  ; MODE = 2 is manual extract and transmission (doesn't update 810.2)
  1.  ; MODE = 3 is manual extract only (doesn't update 810.2)
  1.  ;
  1.  N CLASS,FDA,FDAIEN,MSG
  1.  N PXRMIDOD,PXRMLIST,PXRMNODE,PXRMRULE,PXRMSTRT,PXRMXIEN,PATCREAT,XNAME
  1.  N ITER
  1.  ;Initialise
  1.  K ^TMP("PXRMETX",$J),^TMP("PXRMETX1",$J)
  1.  ;Workfile node for ^TMP
  1.  S PXRMNODE="PXRMRULE"
  1.  ;Get details from parameter file
  1.  N DATA,INDP,INTP,LIST,NAME,PARTYPE,PERIOD,SNAME,TEXT,YEAR
  1.  ;Get class from extract parameter
  1.  S CLASS=$P($G(^PXRM(810.2,IEN,100)),U)
  1.  ;Otherwise default to local
  1.  I $G(CLASS)="" S CLASS="L"
  1.  ;
  1.  S DATA=$G(^PXRM(810.2,IEN,0))
  1.  ;Determine Extract Name and period
  1.  S NAME=$P(DATA,U),PARTYPE=$P(DATA,U,2)
  1.  S YEAR=$P(NEXT,"/",2),PERIOD=$P(NEXT,"/")
  1.  ;Calculate report period start and end dates
  1.  D CALC^PXRMEUT(NEXT,.PXRMSTRT,.PXRMSTOP)
  1.  ;Determine output name for patient list and extract summary
  1.  S XNAME=NAME_" "_YEAR_" "_PERIOD
  1.  S NAME=$$GETNAME(XNAME)
  1.  S ITER=$P(NAME,"/",2)
  1.  ;Process (single) Denominator rule into patient list
  1.  N SEQ,SUB
  1.  S SEQ=""
  1.  F  S SEQ=$O(^PXRM(810.2,IEN,10,"B",SEQ)) Q:'SEQ  D
  1.  .S SUB=$O(^PXRM(810.2,IEN,10,"B",SEQ,"")) Q:'SUB
  1.  .S DATA=$G(^PXRM(810.2,IEN,10,SUB,0)) Q:DATA=""
  1.  .S PXRMRULE=$P(DATA,U,2) Q:'PXRMRULE
  1.  .S LIST=$P(DATA,U,3) Q:LIST=""
  1.  .I LIST["yyyy" S LIST=$P(LIST,"yyyy")_YEAR_$P(LIST,"yyyy",2)
  1.  .I LIST["nn" S LIST=$P(LIST,"nn")_$E(PERIOD,2,10)_$P(LIST,"nn",2)
  1.  .S INDP=+$P(DATA,U,4)
  1.  .S INTP=+$P(DATA,U,5)
  1.  .;Create new patient list
  1.  .I ITER'="" S LIST=LIST_"/"_ITER
  1.  .S PATCREAT="Y",PXRMLIST=$$CRLST^PXRMRUL1(LIST,CLASS) Q:'PXRMLIST
  1.  .;
  1.  .D START^PXRMRULE(PXRMRULE,PXRMLIST,PXRMNODE,PXRMSTRT,PXRMSTOP,IEN,YEAR,PERIOD,INDP,INTP,ITER)
  1.  .;Clear ^TMP lists created for rule
  1.  .D CLEAR^PXRMRULE(PXRMRULE,PXRMNODE)
  1.  .;Process reminders and finding rules
  1.  .;If include deceased patients is true then set the flag so reminders
  1.  .;will be evaluated for deceased patients.
  1.  .S PXRMIDOD=$S(INDP:1,1:0)
  1.  .D REM^PXRMETXR(SUB,PXRMLIST,PXRMSTRT,PXRMSTOP,PARTYPE)
  1.  ;
  1.  ;Get the name
  1.  ;S NAME=$$GETNAME(XNAME)
  1.  ;Create extract summary entry
  1.  S FDA(810.3,"+1,",.01)=NAME
  1.  S FDA(810.3,"+1,",.02)=PXRMSTRT
  1.  S FDA(810.3,"+1,",.03)=PXRMSTOP
  1.  S FDA(810.3,"+1,",.06)=$$NOW^XLFDT
  1.  S FDA(810.3,"+1,",1)=IEN
  1.  S FDA(810.3,"+1,",2)=PARTYPE
  1.  S FDA(810.3,"+1,",3)=$E(PERIOD,2,99)
  1.  S FDA(810.3,"+1,",4)=YEAR
  1.  S FDA(810.3,"+1,",5)=$S(MODE<2:"A",1:"M")
  1.  S FDA(810.3,"+1,",7)=$E(PERIOD)
  1.  I PURGE="Y" S FDA(810.3,"+1,",50)=1
  1.  S FDA(810.3,"+1,",100)=CLASS
  1.  D UPDATE^DIE("","FDA","FDAIEN","MSG")
  1.  I $D(MSG) D AWRITE^PXRMUTIL("MSG") G EXIT
  1.  ;
  1.  ;Update extract summary from ^TMP
  1.  D UPDEX(FDAIEN(1))
  1.  ;
  1.  ;Transmit results
  1.  I (MODE=0)!(MODE=2) D TRANS(FDAIEN(1))
  1.  ;
  1.  ;Update extract parameters
  1.  I MODE<2 D UPDPAR
  1.  ;
  1.  ;Mail message that extract completed
  1.  D MAIL(NAME,NEXT,MODE)
  1.  ;
  1. EXIT ;Clear workfile
  1.  K ^TMP("PXRMETX",$J),^TMP("PXRMETX1",$J)
  1.  Q
  1.  ;
  1. TRANS(PXRMXIEN) ;Transmit HL7 messages
  1.  N HL7ID,NAME,NEXT
  1.  S HL7ID=""
  1.  D HL7^PXRM7API(PXRMXIEN,1,.HL7ID)
  1.  H 2
  1.  ;Lock extract summary
  1.  D LOCK(PXRMXIEN) Q:$D(DUOUT)
  1.  ;Update run information
  1.  S NAME=$P($G(^PXRMXT(810.3,PXRMXIEN,0)),U)
  1.  S NEXT=$P($G(^PXRMXT(810.3,PXRMXIEN,4)),U,3)
  1.  S FDA(810.3,"?1,",.01)=NAME
  1.  S FDA(810.36,"?+2,?1,",.01)=HL7ID
  1.  S FDA(810.36,"?+2,?1,",.02)=$$NOW^XLFDT
  1.  D UPDATE^DIE("","FDA","","MSG")
  1.  ;Unlock extract summary
  1.  D UNLOCK(PXRMXIEN)
  1.  Q
  1.  ;
  1. UPDEX(IEN) ;Update extract summary
  1.  N DUOUT
  1.  ;Lock extract summary
  1.  D LOCK(IEN) Q:$D(DUOUT)
  1.  ;
  1.  ;Update totals section
  1.  N APPL,CNT,DFN,DUE,DATA,ETYP,EVAL
  1.  N FAPPL,FCNT,FDATA,FDUE,FEVAL,FGNAM,FGSTA,FIND,FNAPPL,FNDUE,FSEQ
  1.  N GDATA,GSEQ,INST,NAPPL,NDUE,PCNT,PXRMLIST,RCNT,RIEN,RSEQ,SEQ,TEMP
  1.  S SEQ="",CNT=1,RSEQ=0
  1.  F  S SEQ=$O(^TMP("PXRMETX",$J,SEQ)) Q:SEQ=""  D
  1.  .S INST=0
  1.  .F  S INST=$O(^TMP("PXRMETX",$J,SEQ,INST)) Q:'INST  D
  1.  ..S RCNT=""
  1.  ..F  S RCNT=$O(^TMP("PXRMETX",$J,SEQ,INST,RCNT)) Q:RCNT=""  D
  1.  ...S DATA=$G(^TMP("PXRMETX",$J,SEQ,INST,RCNT)) Q:'DATA
  1.  ...S RIEN=$P(DATA,U,1),EVAL=$P(DATA,U,2),APPL=$P(DATA,U,3)
  1.  ...S NAPPL=$P(DATA,U,4),DUE=$P(DATA,U,5),NDUE=$P(DATA,U,6)
  1.  ...S PXRMLIST=$P(DATA,U,7)
  1.  ...S CNT=CNT+1,RSEQ=RSEQ+1
  1.  ...S TEMP=$$RJ^XLFSTR(RSEQ,3,0)_U_RIEN_U_INST_U_PXRMLIST_U_EVAL_U_APPL_U_NAPPL_U_DUE_U_NDUE
  1.  ...S ^PXRMXT(810.3,IEN,3,RSEQ,0)=TEMP
  1.  ...S ^PXRMXT(810.3,IEN,3,"B",$P(TEMP,U,1),RSEQ)=""
  1.  ...;For each count type
  1.  ...S GSEQ="",FCNT=0
  1.  ...F  S GSEQ=$O(^TMP("PXRMETX1",$J,SEQ,RCNT,GSEQ)) Q:GSEQ=""  D
  1.  ....S GDATA=$G(^TMP("PXRMETX1",$J,SEQ,RCNT,GSEQ))
  1.  ....S FGNAM=$P(GDATA,U),ETYP=$P(GDATA,U,2),FGSTA=$P(GDATA,U,3)
  1.  ....;For each term
  1.  ....S FSEQ=0
  1.  ....F  S FSEQ=$O(^TMP("PXRMETX1",$J,SEQ,RCNT,GSEQ,FSEQ)) Q:FSEQ=""  D
  1.  .....;Get the term ien
  1.  .....S FIND=$P($G(^TMP("PXRMETX1",$J,SEQ,RCNT,GSEQ,FSEQ)),U),FCNT=FCNT+1
  1.  .....;Update finding totals
  1.  .....S FDATA=$G(^TMP("PXRMETX",$J,SEQ,INST,RCNT,GSEQ,FSEQ))
  1.  .....S FEVAL=$P(FDATA,U,2),FAPPL=$P(FDATA,U,3),FNAPPL=$P(FDATA,U,4)
  1.  .....S FDUE=$P(FDATA,U,5),FNDUE=$P(FDATA,U,6)
  1.  .....S TEMP=FSEQ_U_$P(FIND,";")_U_ETYP_U_FEVAL_U_FAPPL_U_FNAPPL_U_FDUE_U_FNDUE_U_FGNAM_U_FGSTA
  1.  .....S ^PXRMXT(810.3,IEN,3,RSEQ,1,FCNT,0)=TEMP
  1.  .....;
  1.  .....;AGP REMOVE UNTIL A DECISION CAN BE MADE
  1.  .....;S DFN=0,PCNT=0
  1.  .....;F  S DFN=$O(^TMP("PXRMETX",$J,SEQ,INST,RCNT,GSEQ,FSEQ,DFN)) Q:DFN'>0  D
  1.  .....;.S PCNT=PCNT+1,^PXRMXT(810.3,IEN,3,RSEQ,1,FCNT,1,PCNT,0)=DFN
  1.  .....;I PCNT>0 S ^PXRMXT(810.3,IEN,3,RSEQ,1,FCNT,1,0)="^810.3316PA"_U_PCNT_U_PCNT
  1.  ....I FCNT>0 S ^PXRMXT(810.3,IEN,3,RSEQ,1,0)="^810.331I"_U_FCNT_U_FCNT
  1.  .I RSEQ>0 S ^PXRMXT(810.3,IEN,3,0)="^810.33I"_U_RSEQ_U_RSEQ
  1.  ;Unlock extract summary
  1.  D UNLOCK(IEN)
  1.  Q
  1.  ;
  1.  ;File locking
  1. LOCK(PXRMXIEN) L +^PXRMXT(810.3,PXRMXIEN):DILOCKTM
  1.  I '$T W !!?5,"Another user is using this extract summary" S DUOUT=1
  1.  Q
  1.  ;
  1. UNLOCK(PXRMXIEN) L -^PXRMXT(810.3,PXRMXIEN) Q
  1.  ;
  1. UPDPAR ;Update parameters when run complete
  1.  N DATA,LAST,NEXT,PERIOD,TYPE,YEAR
  1.  S DATA=$G(^PXRM(810.2,IEN,0)),NEXT=$P(DATA,U,6),TYPE=$P(DATA,U,3)
  1.  ;Last run updated
  1.  S LAST=NEXT
  1.  ;Calculate next run
  1.  I TYPE="Y" S NEXT=NEXT+1
  1.  I "QM"[TYPE D
  1.  .N NUM
  1.  .S PERIOD=$P(NEXT,"/",1),YEAR=$P(NEXT,"/",2)
  1.  .S NUM=$P(PERIOD,TYPE,2)+1
  1.  .I TYPE="Q",NUM>4 S NUM=1,YEAR=YEAR+1
  1.  .I TYPE="M",NUM>12 S NUM=1,YEAR=YEAR+1
  1.  .S NEXT=TYPE_NUM_"/"_YEAR
  1.  ;Update last and next run fields
  1.  S $P(^PXRM(810.2,IEN,0),U,4,6)=LAST_U_$$NOW^XLFDT_U_NEXT
  1.  Q
  1.  ;