APCPREX2 ; IHS/TUCSON/LAB - reexport in date range ; [ 12/16/03 3:16 PM ]
;;2.0;IHS PCC DATA EXTRACTION;**3**;APR 03, 1998
;
;
GENREC ;EP
DELSTAT ;generate new delimited format of the statistical record
S APCPUSED=APCPUSED+1 ;total number of visits used
S APCP("X")=$$VREC(APCP("V DFN"),"STATISTICAL RECORD 1")
D SETTMP
S APCP("X")=$$VREC(APCP("V DFN"),"STATISTICAL RECORD 2")
D SETTMP
S APCP("X")=$$VREC(APCP("V DFN"),"STATISTICAL RECORD 3")
D SETTMP
;cpt records
K AUPNCPT S X=$$CPT^AUPNCPT(APCP("V DFN"))
I $D(AUPNCPT) D
.S (X,APCPV("CPT COUNT"))=0 F S X=$O(AUPNCPT(X)) Q:X'=+X S APCPV("CPT COUNT")=APCPV("CPT COUNT")+1
.S APCPV("CPT RECS")=$S(APCPV("CPT COUNT")#25=0:APCPV("CPT COUNT")/25,1:(APCPV("CPT COUNT")\25)+1) ;IHS/CMI/LAB
.F APCPV("CPT X")=1:1:APCPV("CPT RECS") D
..S P=1,Y=(APCPV("CPT X")*25)-25 K APCPV("CPT SET") F S Y=$O(AUPNCPT(Y)) Q:Y=""!(Y>(APCPV("CPT X")*25)) S $P(APCPV("CPT SET"),U,P)=$P(AUPNCPT(Y),U)_"^" D S P=P+2
...Q:$P(AUPNCPT(Y),U,4)'=9000010.18
...S E=$P(AUPNCPT(Y),U,5) S $P(APCPV("CPT SET"),U,(P+1))=$P($G(^AUPNVCPT(E,0)),U,16)
..S APCP("X")=$$VREC(APCP("V DFN"),"STATISTICAL RECORD 4",APCPV("CPT SET"),APCPV("CPT X"))
..D SETTMP
Q
;
SETTMP ;
S APCPTOTR=APCPTOTR+1
S ^APCPDATA(APCPTOTR)=APCP("X")
Q
VREC(APCPVIEN,APCPRTYP,APCPVAR1,APCPVAR2,APCPVAR3,APCPVAR4,APCPVAR5,APCPVAR6) ;generate 1 record delimited format
S APCPVIEN(0)=^AUPNVSIT(APCPVIEN,0)
S DFN=$P(^AUPNVSIT(APCPVIEN,0),U,5)
NEW APCPRIEN S APCPRIEN=$O(^APCPREC("B",APCPRTYP,0))
I 'APCPRIEN Q ""
NEW APCPY,APCPT S APCPY=0,APCPT="" F S APCPY=$O(^APCPREC(APCPRIEN,11,"B",APCPY)) Q:APCPY'=+APCPY D
.S X=""
.NEW APCPZ S APCPZ=$O(^APCPREC(APCPRIEN,11,"B",APCPY,0))
.Q:'$D(^APCPREC(APCPRIEN,11,APCPZ,1))
.X ^APCPREC(APCPRIEN,11,APCPZ,1)
.S $P(APCPT,U,APCPY)=X
Q APCPT
DATE(D) ;EP - return YYYYMMDD from internal fm format
;IHS/CMI/LAB - added this for Y2K compliance and "^" pieced statistical record
I $G(D)="" Q ""
Q ($E(D,1,3)+1700)_$E(D,4,7)
EXAM(V,N) ;EP - return nth v exam on this visit
I 'V Q ""
I '$D(^AUPNVSIT(V)) Q ""
I '$G(N) Q ""
NEW %,Y,P,C,Z
S (Z,P)="",(Y,C)=0
S Y=0 F S Y=$O(^AUPNVXAM("AD",V,Y)) Q:Y'=+Y S C=C+1 I C=N S P=$P(^AUPNVXAM(Y,0),U),Z=Y
I 'P Q P
I '$D(^AUTTEXAM(P)) Q ""
Q $P(^AUTTEXAM(P,0),U,2)
;
PED(V,N) ;EP - return nth v patient ed on this visit
I 'V Q ""
I '$D(^AUPNVSIT(V)) Q ""
I '$G(N) Q ""
NEW %,Y,P,C,Z
S (Z,P)="",(Y,C)=0
S Y=0 F S Y=$O(^AUPNVPED("AD",V,Y)) Q:Y'=+Y S C=C+1 I C=N S P=$P(^AUPNVPED(Y,0),U),Z=Y
I 'P Q P
I '$D(^AUTTEDT(P)) Q ""
Q $P(^AUTTEDT(P,0),U,2)
;
PHNAC(V) ;
I '$G(V) Q ""
I '$$PHN(V) Q "" ;not a phn visit
I $P(^AUPNVSIT(V,0),U,7)="N" Q "03"
I $$CLINIC^APCLV(V,"C")=11 Q "01"
Q "02"
PHN(V) ;
;is one of the providers a CHN?
I '$G(V) Q ""
NEW X,%,D,N
I $$PRIMPROV^APCLV(V,"D")=13!($$PRIMPROV^APCLV(V,"D")=32) Q 1
S (X,%,N)=0 F S X=$O(^AUPNVPRV("AD",V,X)) Q:X'=+X I $P(^AUPNVPRV(X,0),U,4)'="P" S N=N+1 S D=$$SECPROV^APCLV(V,"D",N) I D=13!(D=32) S %=1
Q %
RZERO(V,L) ;ep right zero fill
NEW %,I
S %=$L(V),Z=L-% F I=1:1:Z S V=V_"0"
Q V
LZERO(V,L) ;EP - left zero fill
NEW %,I
S %=$L(V),Z=L-% F I=1:1:Z S V="0"_V
Q V
LBLK(V,L) ;left blank fill
NEW %,I
S %=$L(V),Z=L-% F I=1:1:Z S V=" "_V
Q V
RBLK(V,L) ;EP right blank fill
NEW %,I
S %=$L(V),Z=L-% F I=1:1:Z S V=V_" "
Q V
APCPREX2 ; IHS/TUCSON/LAB - reexport in date range ; [ 12/16/03 3:16 PM ]
+1 ;;2.0;IHS PCC DATA EXTRACTION;**3**;APR 03, 1998
+2 ;
+3 ;
GENREC ;EP
DELSTAT ;generate new delimited format of the statistical record
+1 ;total number of visits used
SET APCPUSED=APCPUSED+1
+2 SET APCP("X")=$$VREC(APCP("V DFN"),"STATISTICAL RECORD 1")
+3 DO SETTMP
+4 SET APCP("X")=$$VREC(APCP("V DFN"),"STATISTICAL RECORD 2")
+5 DO SETTMP
+6 SET APCP("X")=$$VREC(APCP("V DFN"),"STATISTICAL RECORD 3")
+7 DO SETTMP
+8 ;cpt records
+9 KILL AUPNCPT
SET X=$$CPT^AUPNCPT(APCP("V DFN"))
+10 IF $DATA(AUPNCPT)
Begin DoDot:1
+11 SET (X,APCPV("CPT COUNT"))=0
FOR
SET X=$ORDER(AUPNCPT(X))
IF X'=+X
QUIT
SET APCPV("CPT COUNT")=APCPV("CPT COUNT")+1
+12 ;IHS/CMI/LAB
SET APCPV("CPT RECS")=$SELECT(APCPV("CPT COUNT")#25=0:APCPV("CPT COUNT")/25,1:(APCPV("CPT COUNT")\25)+1)
+13 FOR APCPV("CPT X")=1:1:APCPV("CPT RECS")
Begin DoDot:2
+14 SET P=1
SET Y=(APCPV("CPT X")*25)-25
KILL APCPV("CPT SET")
FOR
SET Y=$ORDER(AUPNCPT(Y))
IF Y=""!(Y>(APCPV("CPT X")*25))
QUIT
SET $PIECE(APCPV("CPT SET"),U,P)=$PIECE(AUPNCPT(Y),U)_"^"
Begin DoDot:3
+15 IF $PIECE(AUPNCPT(Y),U,4)'=9000010.18
QUIT
+16 SET E=$PIECE(AUPNCPT(Y),U,5)
SET $PIECE(APCPV("CPT SET"),U,(P+1))=$PIECE($GET(^AUPNVCPT(E,0)),U,16)
End DoDot:3
SET P=P+2
+17 SET APCP("X")=$$VREC(APCP("V DFN"),"STATISTICAL RECORD 4",APCPV("CPT SET"),APCPV("CPT X"))
+18 DO SETTMP
End DoDot:2
End DoDot:1
+19 QUIT
+20 ;
SETTMP ;
+1 SET APCPTOTR=APCPTOTR+1
+2 SET ^APCPDATA(APCPTOTR)=APCP("X")
+3 QUIT
VREC(APCPVIEN,APCPRTYP,APCPVAR1,APCPVAR2,APCPVAR3,APCPVAR4,APCPVAR5,APCPVAR6) ;generate 1 record delimited format
+1 SET APCPVIEN(0)=^AUPNVSIT(APCPVIEN,0)
+2 SET DFN=$PIECE(^AUPNVSIT(APCPVIEN,0),U,5)
+3 NEW APCPRIEN
SET APCPRIEN=$ORDER(^APCPREC("B",APCPRTYP,0))
+4 IF 'APCPRIEN
QUIT ""
+5 NEW APCPY,APCPT
SET APCPY=0
SET APCPT=""
FOR
SET APCPY=$ORDER(^APCPREC(APCPRIEN,11,"B",APCPY))
IF APCPY'=+APCPY
QUIT
Begin DoDot:1
+6 SET X=""
+7 NEW APCPZ
SET APCPZ=$ORDER(^APCPREC(APCPRIEN,11,"B",APCPY,0))
+8 IF '$DATA(^APCPREC(APCPRIEN,11,APCPZ,1))
QUIT
+9 XECUTE ^APCPREC(APCPRIEN,11,APCPZ,1)
+10 SET $PIECE(APCPT,U,APCPY)=X
End DoDot:1
+11 QUIT APCPT
DATE(D) ;EP - return YYYYMMDD from internal fm format
+1 ;IHS/CMI/LAB - added this for Y2K compliance and "^" pieced statistical record
+2 IF $GET(D)=""
QUIT ""
+3 QUIT ($EXTRACT(D,1,3)+1700)_$EXTRACT(D,4,7)
EXAM(V,N) ;EP - return nth v exam on this visit
+1 IF 'V
QUIT ""
+2 IF '$DATA(^AUPNVSIT(V))
QUIT ""
+3 IF '$GET(N)
QUIT ""
+4 NEW %,Y,P,C,Z
+5 SET (Z,P)=""
SET (Y,C)=0
+6 SET Y=0
FOR
SET Y=$ORDER(^AUPNVXAM("AD",V,Y))
IF Y'=+Y
QUIT
SET C=C+1
IF C=N
SET P=$PIECE(^AUPNVXAM(Y,0),U)
SET Z=Y
+7 IF 'P
QUIT P
+8 IF '$DATA(^AUTTEXAM(P))
QUIT ""
+9 QUIT $PIECE(^AUTTEXAM(P,0),U,2)
+10 ;
PED(V,N) ;EP - return nth v patient ed on this visit
+1 IF 'V
QUIT ""
+2 IF '$DATA(^AUPNVSIT(V))
QUIT ""
+3 IF '$GET(N)
QUIT ""
+4 NEW %,Y,P,C,Z
+5 SET (Z,P)=""
SET (Y,C)=0
+6 SET Y=0
FOR
SET Y=$ORDER(^AUPNVPED("AD",V,Y))
IF Y'=+Y
QUIT
SET C=C+1
IF C=N
SET P=$PIECE(^AUPNVPED(Y,0),U)
SET Z=Y
+7 IF 'P
QUIT P
+8 IF '$DATA(^AUTTEDT(P))
QUIT ""
+9 QUIT $PIECE(^AUTTEDT(P,0),U,2)
+10 ;
PHNAC(V) ;
+1 IF '$GET(V)
QUIT ""
+2 ;not a phn visit
IF '$$PHN(V)
QUIT ""
+3 IF $PIECE(^AUPNVSIT(V,0),U,7)="N"
QUIT "03"
+4 IF $$CLINIC^APCLV(V,"C")=11
QUIT "01"
+5 QUIT "02"
PHN(V) ;
+1 ;is one of the providers a CHN?
+2 IF '$GET(V)
QUIT ""
+3 NEW X,%,D,N
+4 IF $$PRIMPROV^APCLV(V,"D")=13!($$PRIMPROV^APCLV(V,"D")=32)
QUIT 1
+5 SET (X,%,N)=0
FOR
SET X=$ORDER(^AUPNVPRV("AD",V,X))
IF X'=+X
QUIT
IF $PIECE(^AUPNVPRV(X,0),U,4)'="P"
SET N=N+1
SET D=$$SECPROV^APCLV(V,"D",N)
IF D=13!(D=32)
SET %=1
+6 QUIT %
RZERO(V,L) ;ep right zero fill
+1 NEW %,I
+2 SET %=$LENGTH(V)
SET Z=L-%
FOR I=1:1:Z
SET V=V_"0"
+3 QUIT V
LZERO(V,L) ;EP - left zero fill
+1 NEW %,I
+2 SET %=$LENGTH(V)
SET Z=L-%
FOR I=1:1:Z
SET V="0"_V
+3 QUIT V
LBLK(V,L) ;left blank fill
+1 NEW %,I
+2 SET %=$LENGTH(V)
SET Z=L-%
FOR I=1:1:Z
SET V=" "_V
+3 QUIT V
RBLK(V,L) ;EP right blank fill
+1 NEW %,I
+2 SET %=$LENGTH(V)
SET Z=L-%
FOR I=1:1:Z
SET V=V_" "
+3 QUIT V
