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

PSUDEM2.m

Go to the documentation of this file. 
  1. PSUDEM2 ;BIR/DAM - Outpatient Visits Extract ; 1/23/09 3:10pm
  1.  ;;4.0;PHARMACY BENEFITS MANAGEMENT;**15**;MARCH, 2005;Build 2
  1.  ;
  1.  ;DBIA's
  1.  ; Reference to file 2            supported by DBIA 10035
  1.  ; Reference to file 9000010.07   supported by DBIA 3094
  1.  ; Reference to file 9000010      supported by DBIA 3512
  1.  ; Reference to file 4.3          supported by DBIA 2496
  1.  ; Reference to file 80           supported by DBIA 10082
  1.  ; Reference to file 9000010.18   supported by DBIA 3560
  1.  ; Reference to file 81           supported by DBIA 2815
  1. EN ;EN Called from PSUCP
  1.  K ^XTMP("PSU_"_PSUJOB,"PSUOPV"),^XTMP("PSU_"_PSUJOB,"PSUTMP")
  1.  K NONE
  1.  NEW CPTDA,CPTNM,ICD9DA,ICD9NM,PSUICN,PSUSSN,PSUSUB,PSUTEDT
  1.  NEW PSUVSTDT,PSUX,PSUY,PTSTAT,SEG,VCPTDA,XX,J
  1.  D DAT1
  1.  I '$D(^XTMP("PSU_"_PSUJOB,"PSUTMP")) D NODATA
  1.  D XMD
  1. EX K ^XTMP("PSU_"_PSUJOB,"PSUPDFLAG")
  1.  K ^XTMP("PSU_"_PSUJOB,"PSUOPV")
  1.  K ^XTMP("PSU_"_PSUJOB,"PSUXMD")
  1.  K ^XTMP("PSU_"_PSUJOB,"PSUTMP")
  1.  Q
  1.  ;
  1.  ;
  1. DAT1 ;Find visits from V POV file that fall within the date range
  1.  S PSUTEDT=PSUEDT
  1.  S PSUDT=PSUSDT-1,PSUX=9999999-PSUDT,PSUY=9999999-PSUEDT N PSUEDT
  1.  S PSUY=PSUSDT-.0001
  1.  F  S PSUY=$O(^AUPNVSIT("B",PSUY)) Q:PSUY'>0  Q:((PSUY\1)>PSUTEDT)  D
  1.  . S PSUVIEN=0 F  S PSUVIEN=$O(^AUPNVSIT("B",PSUY,PSUVIEN)) Q:$G(PSUVIEN)'>0  D
  1.  .. S PSUPT=$$VALI^PSUTL(9000010,PSUVIEN,.05)
  1.  .. D DAT2
  1.  Q
  1. DAT2 ;
  1.  S PSUPOV=0 F  S PSUPOV=$O(^AUPNVPOV("AD",PSUVIEN,PSUPOV)) Q:PSUPOV'>0  D
  1.  .N PSUVIEN
  1.  .S PSUVIEN=$P($G(^AUPNVPOV(PSUPOV,0)),U,3)
  1.  .Q:PSUVIEN=""
  1.  .Q:$D(^XTMP("PSU"_PSUJOB,"PSUOPV",PSUVIEN))  ; quit if visit psuvien already stored
  1.  . D POVS
  1.  .S PSUVSTDT=$P($G(^AUPNVSIT(PSUVIEN,0)),U)\1
  1.  .S PSUSSN=$P(^DPT(PSUPT,0),U,9)
  1.  .S PSUICN=$$GETICN^MPIF001(PSUPT)
  1.  .I PSUICN[-1 S PSUICN=""
  1.  .;PSU*4*15 Protect from empty 150 nodes
  1.  .S PTSTAT=$P($G(^AUPNVSIT(PSUVIEN,150)),U,2),PTSTAT=$S(+PTSTAT:"I",1:"O")
  1.  . D SET
  1.  Q
  1. POVS ;severl POVs can have same visit, work all when the first is found
  1.  N PSUPOV
  1.  ;PSU*4*15 move kills out of loop.
  1.  K ALLICD9,ALLCPT
  1.  S PSUPOV=0 F  S PSUPOV=$O(^AUPNVPOV("AD",PSUVIEN,PSUPOV)) Q:PSUPOV'>0  D
  1.  .;LOOP CPTs linked by visit
  1.  . S VCPTDA=0 F  S VCPTDA=$O(^AUPNVCPT("AD",PSUVIEN,VCPTDA)) Q:VCPTDA'>0  D
  1.  .. ; get/gather cpts
  1.  ..S CPTDA=$P($G(^AUPNVCPT(VCPTDA,0)),U),CPTNM=$P($G(^ICPT(CPTDA,0)),U) S:$L(CPTNM) ALLCPT(CPTNM)=""
  1.  .. ;get/gather icd9s 
  1.  ..S ICD9DA=$P($G(^AUPNVCPT(VCPTDA,0)),U,5) I ICD9DA S ICD9NM=$P($G(^ICD9(ICD9DA,0)),U) S:$L(ICD9NM) ALLICD9(ICD9NM)=""
  1.  . ;get orig ICD9
  1.  .S ICD9DA=$P($G(^AUPNVPOV(PSUPOV,0)),U) I ICD9DA S ICD9NM=$P($G(^ICD9(ICD9DA,0)),U) S:$L(ICD9NM) ALLICD9(ICD9NM)=""
  1.  Q
  1. SET ; Set segment
  1.  I '$D(ALLICD9),'$D(ALLCPT) Q  ;insure visit has either CPT or ICD9
  1.  ;assemble elements and set
  1.  S SEG=U_PSUSNDR_U_PTSTAT_U_PSUVSTDT_U_PSUSSN_U_PSUICN_U
  1.  I $D(ALLICD9) S ICD9NM="" F I=7:1:16 S ICD9NM=$O(ALLICD9(ICD9NM)) Q:ICD9NM=""  S $P(SEG,U,I)=ICD9NM
  1.  I $D(ALLCPT) S CPTNM="" F J=17:1:26 S CPTNM=$O(ALLCPT(CPTNM)) Q:CPTNM=""  S $P(SEG,U,J)=CPTNM
  1.  S $P(SEG,U,27)=""
  1.  S ^XTMP("PSU_"_PSUJOB,"PSUTMP",PSUVIEN)=SEG
  1.  Q
  1.  ;
  1. XMD ;Format mailman message and send.
  1.  S PSUAB=0
  1.  F PSUPL=1:1 S PSUAB=$O(^XTMP("PSU_"_PSUJOB,"PSUTMP",PSUAB)) Q:PSUAB'>0  S XX=^(PSUAB) D
  1.  . S ^XTMP("PSU_"_PSUJOB,"PSUOPV",PSUPL)=XX
  1.  NEW PSUMAX,PSULC,PSUTMC,PSUTLC,PSUMC
  1.  S PSUMAX=$$VAL^PSUTL(4.3,1,8.3)
  1.  S PSUMAX=$S(PSUMAX="":10000,PSUMAX>10000:10000,1:PSUMAX)
  1.  S PSUMC=1,PSUMLC=0
  1.  F PSULC=1:1 S X=$G(^XTMP("PSU_"_PSUJOB,"PSUOPV",PSULC)) Q:X=""  D
  1.  .S PSUMLC=PSUMLC+1
  1.  .I PSUMLC>PSUMAX S PSUMC=PSUMC+1,PSUMLC=0,PSULC=PSULC-1 Q  ; +  message
  1.  .I $L(X)<235 S ^XTMP("PSU_"_PSUJOB,"PSUXMD",PSUMC,PSUMLC)=X Q
  1.  .F I=235:-1:1 S Z=$E(X,I) Q:Z="^"
  1.  .S ^XTMP("PSU_"_PSUJOB,"PSUXMD",PSUMC,PSUMLC)=$E(X,1,I)
  1.  .S PSUMLC=PSUMLC+1
  1.  .S ^XTMP("PSU_"_PSUJOB,"PSUXMD",PSUMC,PSUMLC)="*"_$E(X,I+1,999)
  1.  ;
  1. TLC ;   Count Lines sent
  1.  S PSUTLC=0
  1.  F PSUM=1:1:PSUMC S X=$O(^XTMP("PSU_"_PSUJOB,"PSUXMD",PSUM,""),-1),PSUTLC=PSUTLC+X
  1.  ;
  1.  F PSUM=1:1:PSUMC D OPV^PSUDEM5
  1.  D CONF
  1.  Q
  1. CONF ;Construct globals for confirmation message
  1.  ;
  1.  I $G(NONE) S PSUTLC=0
  1.  N PSUDIVIS
  1.  S PSUDIVIS=$P(^XTMP("PSU_"_PSUJOB,"PSUSITE"),U,1)
  1.  S PSUSUB="PSU_"_PSUJOB
  1.  S ^XTMP(PSUSUB,"CONFIRM",PSUDIVIS,8,"M")=PSUMC
  1.  S ^XTMP(PSUSUB,"CONFIRM",PSUDIVIS,8,"L")=PSUTLC
  1.  Q
  1.  ;
  1. NODATA ;Generate a 'No data' message if there is no data in the extract
  1.  ;
  1.  S NONE=1
  1.  M PSUXMYH=PSUXMYS1
  1.  S PSUM=1
  1.  S ^XTMP("PSU_"_PSUJOB,"PSUXMD",PSUM,1)="No data to report"
  1.  Q
  1. REC ;EN If "^" is contained in any record, replace it with "'"
  1.  ;
  1.  I PSUREC["^" S PSUREC=$TR(PSUREC,"^","'")
  1.  Q