Routine: APCDRETR

APCDRETR ; IHS/CMI/LAB - RETRANSMIT VISIT ;

 ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 ;rejected by the IHS Data System;

 S APCDPAT=""

 F APCDL=0:0 D GETPAT Q:APCDPAT=""  D GETVISIT W:'APCDVSIT !,"No visit selected!!" I APCDVSIT D PROCESS

 D EOJ

EOJ ;

 K APCDPAT,APCDVSIT,APCDY,APCDVDSP,APCDVR,APCDLOOK,APCDCAT,APCDCLN,APCDDATE,APCDL,APCDLOC,APCDRETR,APCDTYPE

 K AUPNPAT,AUPNDAYS,AUPNSEX,AUPNDOD,AUPNDOB

 K DA,DR,DIE

GETPAT ; GET PATIENT

W !

 S APCDPAT=""

 S DIC="^AUPNPAT(",DIC(0)="AEMQ" D ^DIC K DIC

 Q:Y<0

 S APCDPAT=+Y

GETVISIT ; GET VISIT

 S APCDVSIT=""

 D ^APCDVLK

 I APCDVSIT I AUPNDOB]"" S X2=AUPNDOB,X1=APCDDATE D ^%DTC S AUPNDAYS=X ; re-set days of age to visit date-dob

 I APCDVSIT K DR S APCDVDSP=APCDVSIT D ^APCDVDSP

PROCESS ;

 W !,"Are you sure this is the visit to re-transmit" S %=2 D YN^DICN S %Y=$E(%Y)

 Q:"Nn"[%Y

 S APCDVR=^AUPNVSIT(APCDVSIT,0)

 I $P(APCDVR,U,11) W $C(7),!!,"This visit has been deleted!!",! Q

 I '$P(APCDVR,U,9) W $C(7),!!,"This visit does not have any dependent entries - no data to transmit!!",! Q

 D C1 Q

 ;I $P(APCDVR,U,14)]"" D C2 Q

C1 ;W $C(7),!!,"This Visit has not been flagged as ever having been successfully sent to",!,"the IHS Data Center!",!

 W !,"I will re-set the Data Warehouse flag to re-send this visit as of today's",!,"Posting Date."

C1R ;

 S DIR(0)="Y",DIR("A")="Do you want to continue",DIR("B")="N" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 I $D(DIRUT)!(Y=0) W !,"BYE" Q

 S AUPNVSIT=APCDVSIT D MOD^AUPNVSIT

 K DA,DR,DIE,DIROUT,DUOUT,DTOUT,Y,X

C2 ;

 W !!,"This visit has already been transmitted to the IHS Data Center once.",!,"This will cause the visit to be re-transmitted to the Data Center.",!!

C2R W !!,"Have all corrections to the visit been made through modify or append mode",!,"so that the visit will now be accepted by the Data Center (either PCIS or the",!,"the IHS Inpatient System?",!

 S DIR(0)="Y",DIR("A")="Enter Yes or No",DIR("B")="N" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 I $D(DIRUT) W $C(7),"Bye" Q

 I Y=0 W $C(7),!!,"Make corrections and then try again!",!! Q

 S APCDRETR="",DA=APCDVSIT,DR=".14///@",DIE="^AUPNVSIT(" D ^DIE K DA,DR,DIE

 S AUPNVSIT=APCDVSIT D MOD^AUPNVSIT

 W !!,"Visit will be re-sent as of Today's Date",! Q

APCDRETR  ; IHS/CMI/LAB - RETRANSMIT VISIT ;

 +1       ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 +2       ;rejected by the IHS Data System;

 +3        SET APCDPAT=""

 +4        FOR APCDL=0:0

               DO GETPAT

               IF APCDPAT=""

                   QUIT

               DO GETVISIT

               IF 'APCDVSIT

                   WRITE !,"No visit selected!!"

               IF APCDVSIT

                   DO PROCESS

 +5        DO EOJ

 +6        QUIT

 +7       ;

EOJ       ;

 +1        KILL APCDPAT,APCDVSIT,APCDY,APCDVDSP,APCDVR,APCDLOOK,APCDCAT,APCDCLN,APCDDATE,APCDL,APCDLOC,APCDRETR,APCDTYPE

 +2        KILL AUPNPAT,AUPNDAYS,AUPNSEX,AUPNDOD,AUPNDOB

 +3        KILL DA,DR,DIE

 +4        QUIT

GETPAT    ; GET PATIENT

 +1        WRITE !

 +2        SET APCDPAT=""

 +3        SET DIC="^AUPNPAT("

           SET DIC(0)="AEMQ"

           DO ^DIC

           KILL DIC

 +4        IF Y<0

               QUIT

 +5        SET APCDPAT=+Y

 +6        QUIT

 +7       ;

GETVISIT  ; GET VISIT

 +1        SET APCDVSIT=""

 +2        DO ^APCDVLK

 +3       ; re-set days of age to visit date-dob

           IF APCDVSIT

               IF AUPNDOB]""

                   SET X2=AUPNDOB

                   SET X1=APCDDATE

                   DO ^%DTC

                   SET AUPNDAYS=X

 +4        IF APCDVSIT

               KILL DR

               SET APCDVDSP=APCDVSIT

               DO ^APCDVDSP

 +5        QUIT

 +6       ;

PROCESS   ;

 +1        WRITE !,"Are you sure this is the visit to re-transmit"

           SET %=2

           DO YN^DICN

           SET %Y=$EXTRACT(%Y)

 +2        IF "Nn"[%Y

               QUIT

 +3        SET APCDVR=^AUPNVSIT(APCDVSIT,0)

 +4        IF $PIECE(APCDVR,U,11)

               WRITE $CHAR(7),!!,"This visit has been deleted!!",!

               QUIT

 +5        IF '$PIECE(APCDVR,U,9)

               WRITE $CHAR(7),!!,"This visit does not have any dependent entries - no data to transmit!!",!

               QUIT

 +6        DO C1

           QUIT

 +7       ;I $P(APCDVR,U,14)]"" D C2 Q

 +8        QUIT

C1        ;W $C(7),!!,"This Visit has not been flagged as ever having been successfully sent to",!,"the IHS Data Center!",!

 +1        WRITE !,"I will re-set the Data Warehouse flag to re-send this visit as of today's",!,"Posting Date."

C1R       ;

 +1        SET DIR(0)="Y"

           SET DIR("A")="Do you want to continue"

           SET DIR("B")="N"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +2        IF $DATA(DIRUT)!(Y=0)

               WRITE !,"BYE"

               QUIT

 +3        SET AUPNVSIT=APCDVSIT

           DO MOD^AUPNVSIT

 +4        KILL DA,DR,DIE,DIROUT,DUOUT,DTOUT,Y,X

 +5        QUIT

 +6       ;

C2        ;

 +1        WRITE !!,"This visit has already been transmitted to the IHS Data Center once.",!,"This will cause the visit to be re-transmitted to the Data Center.",!!

C2R        WRITE !!,"Have all corrections to the visit been made through modify or append mode",!,"so that the visit will now be accepted by the Data Center (either PCIS or the",!,"the IHS Inpatient System?",!

 +1        SET DIR(0)="Y"

           SET DIR("A")="Enter Yes or No"

           SET DIR("B")="N"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +2        IF $DATA(DIRUT)

               WRITE $CHAR(7),"Bye"

               QUIT

 +3        IF Y=0

               WRITE $CHAR(7),!!,"Make corrections and then try again!",!!

               QUIT

 +4        SET APCDRETR=""

           SET DA=APCDVSIT

           SET DR=".14///@"

           SET DIE="^AUPNVSIT("

           DO ^DIE

           KILL DA,DR,DIE

 +5        SET AUPNVSIT=APCDVSIT

           DO MOD^AUPNVSIT

 +6        WRITE !!,"Visit will be re-sent as of Today's Date",!

           QUIT

 +7        QUIT

APCDRETR.m