APCDDVC ; IHS/CMI/LAB - VISIT REVIEW REPORT ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;
;
GETCHART ;get chart number
S APCDCLOC=""
I $P(APCDDV("VREC"),U,6),$D(^AUPNPAT(DFN,41,$P(APCDDV("VREC"),U,6),0))#2 S APCDCLOC=$P(^(0),U,1),APCDHRN=$P(^(0),U,2)
I APCDCLOC="",$D(^AUPNPAT(DFN,41,DUZ(2),0))#2 S APCDCLOC=$P(^(0),U,1),APCDHRN=$P(^AUPNPAT(DFN,41,DUZ(2),0),U,2)
I APCDCLOC="" S APCDCLOC=$O(^AUPNPAT(DFN,41,0)) I APCDCLOC S APCDHRN=$P(^AUPNPAT(DFN,41,APCDCLOC,0),U,2) G C2
I APCDCLOC=""!('APCDCLOC) S APCDHRN="NONE",APCDCLOC=DUZ(2) Q
C2 ;
Q:APCDCSRT'="T"
S APCDHRN=APCDHRN+10000000,APCDHRN=$E(APCDHRN,7,8)_"-"_+$E(APCDHRN,2,8)
Q
ZERO ; If no dependent entries, save information.
K APCDERR
S APCDEC=1
D ZERO^APCDRV I $D(APCDERR) D GETCHART S ^XTMP("APCDDV",APCDJOB,APCDBT,"ZERO",APCDCLOC,APCDCLIN,APCDHRN,APCDVSIT)="",APCDCNTR("ZERO")=$G(APCDCNTR("ZERO"))+1
D XIT
Q
PPPV ; See if Purpose of Visit and Providers entered correctly
Q:'$P(APCDDV("VREC"),U,9)
Q:"EINX"[$P(APCDDV("VREC"),U,7)
K APCDERR
S APCDEC=1
S APCDVREC=^AUPNVSIT(APCDVSIT,0) D PPPV^APCDR00 K APCDVREC
I $D(APCDERR) D GETCHART S APCDCNTR("PPPV")=$G(APCDCNTR("PPPV"))+1 S APCDX=0 F S APCDX=$O(APCDERR(APCDX)) Q:APCDX'=+APCDX D
.S ^XTMP("APCDDV",APCDJOB,APCDBT,"PPPV",APCDCLOC,APCDCLIN,APCDHRN,APCDVSIT,APCDX)=$P(^APCDERR(APCDERR(APCDX),0),U)_"-"_$P(^APCDERR(APCDERR(APCDX),0),U,3)
D XIT
Q
;
MRG ; FOR CALLER PASSING VISIT DATE
Q:'$P(APCDDV("VREC"),U,9)
Q:$P(APCDDV("VREC"),U,3)="C" ;do not display contract visits per Teresa 01/11/93
Q:"EI"[$P(APCDDV("VREC"),U,7)
D GETCHART
Q:$D(^XTMP("APCDDV",APCDJOB,APCDBT,"AM",APCDCLOC,APCDCLIN,APCDHRN,APCDVSIT))
K APCDKT
S APCDDC=+$P(^AUPNVSIT(APCDVSIT,0),"^")\1,APCDPAT=$P(^(0),"^",5),APCDLOC=$P(^(0),U,6),APCDTYPE=$P(^(0),U,3),APCDCAT=$P(^(0),U,7),(APCDI,APCDV)=0
F S APCDV=$O(^AUPNVSIT("AC",APCDPAT,APCDV)) Q:APCDV="" I APCDDC=(+^AUPNVSIT(APCDV,0)\1),'$P(^(0),U,11),APCDLOC=$P(^(0),U,6),$P(^(0),U,9),APCDTYPE=$P(^(0),U,3),APCDCAT=$P(^(0),U,7) D SETARR
Q:'$D(APCDKT)
I APCDI>1 D CHKCLN
D XIT
Q
SETARR S APCDI=APCDI+1,APCDKT(APCDI)=APCDV_U_$P(^AUPNVSIT(APCDV,0),U,2)_U_$P(^(0),U,8)_U_$P(^(0),U,3)_U_$P(^(0),U,7)
Q
CHKCLN ;
S APCDF="" F APCDII=1:1:APCDI I $P(APCDKT(APCDII),U,3)="" S APCDF=1
F APCDII=1:1:APCDI Q:APCDF=1 S APCDCLN=$P(APCDKT(APCDII),U,3) F APCDJ=APCDII+1:1:APCDI I $P(APCDKT(APCDJ),U,3)=APCDCLN S APCDF=1
I APCDF=1 D
.S APCDCNTR("MRG")=$G(APCDCNTR("MRG"))+1
.F APCDII=1:1:APCDI S ^XTMP("APCDDV",APCDJOB,APCDBT,"MRG",APCDCLOC,APCDCLIN,APCDHRN,APCDVSIT,+APCDKT(APCDII))="",^XTMP("APCDDV",APCDJOB,APCDBT,"AM",APCDCLOC,APCDCLIN,APCDHRN,+APCDKT(APCDII))=""
Q
TXER ; Create transaction error report
Q:$P(APCDDV("VREC"),U,7)="E" ;IHS/CMI/LAB - added this line patch 2
K APCDERR
S APCDEC=1
S X=99,DIC="^DIC(40.7,",DIC(0)="M" D ^DIC K DIC
S APCDDCHS=+Y
I 'APCDDCHS S APCDDCHS=""
S APCDVREC=^AUPNVSIT(APCDVSIT,0) D ^APCDRV K APCDVREC
I $D(APCDERR) D GETCHART S APCDCNTR("TXER")=$G(APCDCNTR("TXER"))+1 S APCDX=0 F S APCDX=$O(APCDERR(APCDX)) Q:APCDX'=+APCDX D SETTXER
D XIT
Q
SETTXER ;
I APCDERR(APCDX)="" S APCDMSG="ERROR DESCRIPTION NOT FOUND IN ERROR FILE",APCDCODE=$O(APCDERR("B",APCDERR(APCDX,"FILE"),APCDERR(APCDX,"ENTRY"),"")) G SETTXER1
S APCDCODE=$P(^APCDERR(APCDERR(APCDX),0),U),APCDMSG=$P(^(0),U,3)
SETTXER1 I $E(APCDCODE,2)=6,$E(APCDCODE,2,4)>612 S ^XTMP("APCDDV",APCDJOB,APCDBT,"TXER","DEMOG",APCDCLOC,APCDCLIN,APCDHRN,APCDVSIT,APCDX)=APCDCODE_"-"_APCDMSG_"^"_APCDERR(APCDX,"FILE")_"^"_APCDERR(APCDX,"ENTRY") Q
I $E(APCDCODE,2)=6 S ^XTMP("APCDDV",APCDJOB,APCDBT,"TXER","DEMOGMAND",APCDCLOC,APCDCLIN,APCDHRN,APCDVSIT,APCDX)=APCDCODE_"-"_APCDMSG_"^"_APCDERR(APCDX,"FILE")_"^"_APCDERR(APCDX,"ENTRY") Q
S ^XTMP("APCDDV",APCDJOB,APCDBT,"TXER",APCDCLOC,APCDCLIN,APCDHRN,APCDVSIT,APCDX)=APCDCODE_"-"_APCDMSG_"^"_APCDERR(APCDX,"FILE")_"^"_APCDERR(APCDX,"ENTRY")
Q
INPT ;
Q:'$P(APCDDV("VREC"),U,9)
Q:"H"'[$P(APCDDV("VREC"),U,7)
Q:"C"[$P(APCDDV("VREC"),U,3)
;skip uncoded visits ***** LAB
K APCDERR
S APCDEC=1
S APCDVREC=^AUPNVSIT(APCDVSIT,0) D ^APCDRV K APCDVREC
I $D(APCDERR) D
.S APCDCNTR("INPT")=$G(APCDCNTR("INPT"))+1
.D GETCHART S APCDX=0 F S APCDX=$O(APCDERR(APCDX)) Q:APCDX'=+APCDX S ^XTMP("APCDDV",APCDJOB,APCDBT,"INPT",APCDCLOC,APCDCLIN,APCDHRN,APCDVSIT,APCDX)=$P(^APCDERR(APCDERR(APCDX),0),U)_"-"_$P(^(0),U,2)
D XIT
Q
ALL ; Entry point to do all reports
D ZERO,PPPV,MRG,TXER,INPT
Q
;
XIT ; Clean up and exit.
K APCDERR,APCDEC,APCDKT,APCDDC,APCDPAT,APCDLOC,APCDTYPE,APCDCAT,APCDI,APCDV,APCDF,APCDJ,APCDII,APCDPDIS,APCDPPRV,APCDPCOD,APCDPAFF,APCDCODE,APCDMSG
Q
APCDDVC ; IHS/CMI/LAB - VISIT REVIEW REPORT ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;
+3 ;
GETCHART ;get chart number
+1 SET APCDCLOC=""
+2 IF $PIECE(APCDDV("VREC"),U,6)
IF $DATA(^AUPNPAT(DFN,41,$PIECE(APCDDV("VREC"),U,6),0))#2
SET APCDCLOC=$PIECE(^(0),U,1)
SET APCDHRN=$PIECE(^(0),U,2)
+3 IF APCDCLOC=""
IF $DATA(^AUPNPAT(DFN,41,DUZ(2),0))#2
SET APCDCLOC=$PIECE(^(0),U,1)
SET APCDHRN=$PIECE(^AUPNPAT(DFN,41,DUZ(2),0),U,2)
+4 IF APCDCLOC=""
SET APCDCLOC=$ORDER(^AUPNPAT(DFN,41,0))
IF APCDCLOC
SET APCDHRN=$PIECE(^AUPNPAT(DFN,41,APCDCLOC,0),U,2)
GOTO C2
+5 IF APCDCLOC=""!('APCDCLOC)
SET APCDHRN="NONE"
SET APCDCLOC=DUZ(2)
QUIT
C2 ;
+1 IF APCDCSRT'="T"
QUIT
+2 SET APCDHRN=APCDHRN+10000000
SET APCDHRN=$EXTRACT(APCDHRN,7,8)_"-"_+$EXTRACT(APCDHRN,2,8)
+3 QUIT
ZERO ; If no dependent entries, save information.
+1 KILL APCDERR
+2 SET APCDEC=1
+3 DO ZERO^APCDRV
IF $DATA(APCDERR)
DO GETCHART
SET ^XTMP("APCDDV",APCDJOB,APCDBT,"ZERO",APCDCLOC,APCDCLIN,APCDHRN,APCDVSIT)=""
SET APCDCNTR("ZERO")=$GET(APCDCNTR("ZERO"))+1
+4 DO XIT
+5 QUIT
PPPV ; See if Purpose of Visit and Providers entered correctly
+1 IF '$PIECE(APCDDV("VREC"),U,9)
QUIT
+2 IF "EINX"[$PIECE(APCDDV("VREC"),U,7)
QUIT
+3 KILL APCDERR
+4 SET APCDEC=1
+5 SET APCDVREC=^AUPNVSIT(APCDVSIT,0)
DO PPPV^APCDR00
KILL APCDVREC
+6 IF $DATA(APCDERR)
DO GETCHART
SET APCDCNTR("PPPV")=$GET(APCDCNTR("PPPV"))+1
SET APCDX=0
FOR
SET APCDX=$ORDER(APCDERR(APCDX))
IF APCDX'=+APCDX
QUIT
Begin DoDot:1
+7 SET ^XTMP("APCDDV",APCDJOB,APCDBT,"PPPV",APCDCLOC,APCDCLIN,APCDHRN,APCDVSIT,APCDX)=$PIECE(^APCDERR(APCDERR(APCDX),0),U)_"-"_$PIECE(^APCDERR(APCDERR(APCDX),0),U,3)
End DoDot:1
+8 DO XIT
+9 QUIT
+10 ;
MRG ; FOR CALLER PASSING VISIT DATE
+1 IF '$PIECE(APCDDV("VREC"),U,9)
QUIT
+2 ;do not display contract visits per Teresa 01/11/93
IF $PIECE(APCDDV("VREC"),U,3)="C"
QUIT
+3 IF "EI"[$PIECE(APCDDV("VREC"),U,7)
QUIT
+4 DO GETCHART
+5 IF $DATA(^XTMP("APCDDV",APCDJOB,APCDBT,"AM",APCDCLOC,APCDCLIN,APCDHRN,APCDVSIT))
QUIT
+6 KILL APCDKT
+7 SET APCDDC=+$PIECE(^AUPNVSIT(APCDVSIT,0),"^")\1
SET APCDPAT=$PIECE(^(0),"^",5)
SET APCDLOC=$PIECE(^(0),U,6)
SET APCDTYPE=$PIECE(^(0),U,3)
SET APCDCAT=$PIECE(^(0),U,7)
SET (APCDI,APCDV)=0
+8 FOR
SET APCDV=$ORDER(^AUPNVSIT("AC",APCDPAT,APCDV))
IF APCDV=""
QUIT
IF APCDDC=(+^AUPNVSIT(APCDV,0)\1)
IF '$PIECE(^(0),U,11)
IF APCDLOC=$PIECE(^(0),U,6)
IF $PIECE(^(0),U,9)
IF APCDTYPE=$PIECE(^(0),U,3)
IF APCDCAT=$PIECE(^(0),U,7)
DO SETARR
+9 IF '$DATA(APCDKT)
QUIT
+10 IF APCDI>1
DO CHKCLN
+11 DO XIT
+12 QUIT
SETARR SET APCDI=APCDI+1
SET APCDKT(APCDI)=APCDV_U_$PIECE(^AUPNVSIT(APCDV,0),U,2)_U_$PIECE(^(0),U,8)_U_$PIECE(^(0),U,3)_U_$PIECE(^(0),U,7)
+1 QUIT
CHKCLN ;
+1 SET APCDF=""
FOR APCDII=1:1:APCDI
IF $PIECE(APCDKT(APCDII),U,3)=""
SET APCDF=1
+2 FOR APCDII=1:1:APCDI
IF APCDF=1
QUIT
SET APCDCLN=$PIECE(APCDKT(APCDII),U,3)
FOR APCDJ=APCDII+1:1:APCDI
IF $PIECE(APCDKT(APCDJ),U,3)=APCDCLN
SET APCDF=1
+3 IF APCDF=1
Begin DoDot:1
+4 SET APCDCNTR("MRG")=$GET(APCDCNTR("MRG"))+1
+5 FOR APCDII=1:1:APCDI
SET ^XTMP("APCDDV",APCDJOB,APCDBT,"MRG",APCDCLOC,APCDCLIN,APCDHRN,APCDVSIT,+APCDKT(APCDII))=""
SET ^XTMP("APCDDV",APCDJOB,APCDBT,"AM",APCDCLOC,APCDCLIN,APCDHRN,+APCDKT(APCDII))=""
End DoDot:1
+6 QUIT
TXER ; Create transaction error report
+1 ;IHS/CMI/LAB - added this line patch 2
IF $PIECE(APCDDV("VREC"),U,7)="E"
QUIT
+2 KILL APCDERR
+3 SET APCDEC=1
+4 SET X=99
SET DIC="^DIC(40.7,"
SET DIC(0)="M"
DO ^DIC
KILL DIC
+5 SET APCDDCHS=+Y
+6 IF 'APCDDCHS
SET APCDDCHS=""
+7 SET APCDVREC=^AUPNVSIT(APCDVSIT,0)
DO ^APCDRV
KILL APCDVREC
+8 IF $DATA(APCDERR)
DO GETCHART
SET APCDCNTR("TXER")=$GET(APCDCNTR("TXER"))+1
SET APCDX=0
FOR
SET APCDX=$ORDER(APCDERR(APCDX))
IF APCDX'=+APCDX
QUIT
DO SETTXER
+9 DO XIT
+10 QUIT
SETTXER ;
+1 IF APCDERR(APCDX)=""
SET APCDMSG="ERROR DESCRIPTION NOT FOUND IN ERROR FILE"
SET APCDCODE=$ORDER(APCDERR("B",APCDERR(APCDX,"FILE"),APCDERR(APCDX,"ENTRY"),""))
GOTO SETTXER1
+2 SET APCDCODE=$PIECE(^APCDERR(APCDERR(APCDX),0),U)
SET APCDMSG=$PIECE(^(0),U,3)
SETTXER1 IF $EXTRACT(APCDCODE,2)=6
IF $EXTRACT(APCDCODE,2,4)>612
SET ^XTMP("APCDDV",APCDJOB,APCDBT,"TXER","DEMOG",APCDCLOC,APCDCLIN,APCDHRN,APCDVSIT,APCDX)=APCDCODE_"-"_APCDMSG_"^"_APCDERR(APCDX,"FILE")_"^"_APCDERR(APCDX,"ENTRY")
QUIT
+1 IF $EXTRACT(APCDCODE,2)=6
SET ^XTMP("APCDDV",APCDJOB,APCDBT,"TXER","DEMOGMAND",APCDCLOC,APCDCLIN,APCDHRN,APCDVSIT,APCDX)=APCDCODE_"-"_APCDMSG_"^"_APCDERR(APCDX,"FILE")_"^"_APCDERR(APCDX,"ENTRY")
QUIT
+2 SET ^XTMP("APCDDV",APCDJOB,APCDBT,"TXER",APCDCLOC,APCDCLIN,APCDHRN,APCDVSIT,APCDX)=APCDCODE_"-"_APCDMSG_"^"_APCDERR(APCDX,"FILE")_"^"_APCDERR(APCDX,"ENTRY")
+3 QUIT
INPT ;
+1 IF '$PIECE(APCDDV("VREC"),U,9)
QUIT
+2 IF "H"'[$PIECE(APCDDV("VREC"),U,7)
QUIT
+3 IF "C"[$PIECE(APCDDV("VREC"),U,3)
QUIT
+4 ;skip uncoded visits ***** LAB
+5 KILL APCDERR
+6 SET APCDEC=1
+7 SET APCDVREC=^AUPNVSIT(APCDVSIT,0)
DO ^APCDRV
KILL APCDVREC
+8 IF $DATA(APCDERR)
Begin DoDot:1
+9 SET APCDCNTR("INPT")=$GET(APCDCNTR("INPT"))+1
+10 DO GETCHART
SET APCDX=0
FOR
SET APCDX=$ORDER(APCDERR(APCDX))
IF APCDX'=+APCDX
QUIT
SET ^XTMP("APCDDV",APCDJOB,APCDBT,"INPT",APCDCLOC,APCDCLIN,APCDHRN,APCDVSIT,APCDX)=$PIECE(^APCDERR(APCDERR(APCDX),0),U)_"-"_$PIECE(^(0),U,2)
End DoDot:1
+11 DO XIT
+12 QUIT
ALL ; Entry point to do all reports
+1 DO ZERO
DO PPPV
DO MRG
DO TXER
DO INPT
+2 QUIT
+3 ;
XIT ; Clean up and exit.
+1 KILL APCDERR,APCDEC,APCDKT,APCDDC,APCDPAT,APCDLOC,APCDTYPE,APCDCAT,APCDI,APCDV,APCDF,APCDJ,APCDII,APCDPDIS,APCDPPRV,APCDPCOD,APCDPAFF,APCDCODE,APCDMSG
+2 QUIT
