APCDDVC.m

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