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