AGTX.m

AGTX ; IHS/ASDS/EFG - EXPORT REG DATA ;   

 ;;7.1;PATIENT REGISTRATION;;AUG 25,2005

 S:'$D(DTIME) DTIME=300 S:DTIME="" DTIME=300

 G START

HEADER ;EP -

 D:'$D(AGOPT) ^AGVAR

 U IO(0) W $$S^AGVDF("IOF"),! F I=1:1:79 W "*"

 W !,"*",?27,"EXPORT REGISTRATION DATA",?78,"*",! F I=1:1:79 W "*"

 W !

 Q

START S:'$D(DUZ) DUZ=1

 S:'$G(AGTXSITE) AGTXSITE=$P(^AUTTSITE(1,0),"^")

 S (AG("TOT"),AGBAD16,AGBAD26,AGBAD51,AGROUT)=0,IOP=ION D ^%ZIS,VIDEO^AG,HEADER

 F %=1:1:8 S AG("TOT",%)=0

 W !?10,"SITE NAME IS:  ",$P(^DIC(4,AGTXSITE,0),U)

 W !!,"The following are ""Parent Facilites for Registration""."

 W !!,"ONLY their Demographic and HRN Changes, Deletes, and Merges",!,"will be sent to NPIRS :",!

 S AGPSITE=0 F  S AGPSITE=$O(^AGFAC("AC",AGPSITE)) Q:'AGPSITE  W !,?10,$P(^DIC(4,AGPSITE,0),"^")

L11A W !!,"DO YOU WANT TO DISPLAY OUTPUT RECORDS ON SCREEN (Y/N) Y// " D READ^AG S Y=$E(Y_"Y") S AGOUTFLG=$S(Y="Y":1,Y="N":0,1:2) Q:$D(DUOUT)!$D(DTOUT)!$D(DFOUT)  I AGOUTFLG=2 D YN^AG G L11A

 D ^AGTX0

S2 G JOBEND^AGTX4:'$D(AGRR1) S AGRCT=0,AGLDATE=AGRR1 X XY,XYER

 G S2A^AGTX1

RESET ;EP -

 ;This function contained in agr1^agtxst

 W !,*7,"GOT TO RESET^AGTX IN ERROR",!

 Q

 S AG("X")=$P(^AGTXST(AGTXSITE,1,0),U,3)

 K ^AGTXST(AGTXSITE,1,AG("X"),0)

 S AG("X")=AG("X")-1 S $P(^AGTXST(AGTXSITE,1,0),U,3)=AG("X"),$P(^AGTXST(AGTXSITE,1,0),U,4)=AG("X")

 K AG("X")

 Q

REGEN ;EP - (from option) - Regenerate old tape.

 S AGTXSITE=$P(^AUTTSITE(1,0),"^")

 I '$D(^AGTXST(AGTXSITE)) W !,*7,"No export records for this facility.",! G ENTRETRN^AGTX4

 S DIC="^AGTXST(AGTXSITE,1,",DIC(0)="AEFMQZ",D="B",DZ="??" D DQ^DICQ,^DIC K DIC,D,DZ Q:Y<1

 S AG("REGEN")=Y(0)

 G AGTX

TEST ;EP - Test a transmission with a small date range

 S %DT="AE",%DT("A")="Start date: " D ^%DT Q:Y'>0  S AGBDT=Y

 S %DT="AE",%DT("A")="Stop date: ",%DT(0)=Y D ^%DT Q:Y'>0  S AGEDT=Y

 K %DT(0)

 S AG("REGEN")="^"_AGBDT_"^"_AGEDT

 S AGBDT=AGBDT,AGEDT=AGEDT+.9

 S AGLO="^AGPATCH("_AGBDT_")" F  S AGLO=$Q(@AGLO) Q:(AGLO=""!(AGLO["ER"))  S AGDT=$P(AGLO,"(",2),AGDT=$P(AGDT,",") Q:(AGDT>AGEDT)  W !,AGLO," = ",@AGLO

 K AGBDT,AGEDT

 W !,"EXITING WILL KILL AG(""REGEN"")",!

 S DIR(0)="E" D ^DIR I X["^" K AG("REGEN") Q

 G AGTX

AGTX      ; IHS/ASDS/EFG - EXPORT REG DATA ;   

 +1       ;;7.1;PATIENT REGISTRATION;;AUG 25,2005

 +2        IF '$DATA(DTIME)

               SET DTIME=300

           IF DTIME=""

               SET DTIME=300

 +3        GOTO START

HEADER    ;EP -

 +1        IF '$DATA(AGOPT)

               DO ^AGVAR

 +2        USE IO(0)

           WRITE $$S^AGVDF("IOF"),!

           FOR I=1:1:79

               WRITE "*"

 +3        WRITE !,"*",?27,"EXPORT REGISTRATION DATA",?78,"*",!

           FOR I=1:1:79

               WRITE "*"

 +4        WRITE !

 +5        QUIT 

START      IF '$DATA(DUZ)

               SET DUZ=1

 +1        IF '$GET(AGTXSITE)

               SET AGTXSITE=$PIECE(^AUTTSITE(1,0),"^")

 +2        SET (AG("TOT"),AGBAD16,AGBAD26,AGBAD51,AGROUT)=0

           SET IOP=ION

           DO ^%ZIS

           DO VIDEO^AG

           DO HEADER

 +3        FOR %=1:1:8

               SET AG("TOT",%)=0

 +4        WRITE !?10,"SITE NAME IS:  ",$PIECE(^DIC(4,AGTXSITE,0),U)

 +5        WRITE !!,"The following are ""Parent Facilites for Registration""."

 +6        WRITE !!,"ONLY their Demographic and HRN Changes, Deletes, and Merges",!,"will be sent to NPIRS :",!

 +7        SET AGPSITE=0

           FOR 

               SET AGPSITE=$ORDER(^AGFAC("AC",AGPSITE))

               IF 'AGPSITE

                   QUIT 

               WRITE !,?10,$PIECE(^DIC(4,AGPSITE,0),"^")

L11A       WRITE !!,"DO YOU WANT TO DISPLAY OUTPUT RECORDS ON SCREEN (Y/N) Y// "

           DO READ^AG

           SET Y=$EXTRACT(Y_"Y")

           SET AGOUTFLG=$SELECT(Y="Y":1,Y="N":0,1:2)

           IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DFOUT)

               QUIT 

           IF AGOUTFLG=2

               DO YN^AG

               GOTO L11A

 +1        DO ^AGTX0

S2         IF '$DATA(AGRR1)

               GOTO JOBEND^AGTX4

           SET AGRCT=0

           SET AGLDATE=AGRR1

           XECUTE XY

           XECUTE XYER

 +1        GOTO S2A^AGTX1

RESET     ;EP -

 +1       ;This function contained in agr1^agtxst

 +2        WRITE !,*7,"GOT TO RESET^AGTX IN ERROR",!

 +3        QUIT 

 +4        SET AG("X")=$PIECE(^AGTXST(AGTXSITE,1,0),U,3)

 +5        KILL ^AGTXST(AGTXSITE,1,AG("X"),0)

 +6        SET AG("X")=AG("X")-1

           SET $PIECE(^AGTXST(AGTXSITE,1,0),U,3)=AG("X")

           SET $PIECE(^AGTXST(AGTXSITE,1,0),U,4)=AG("X")

 +7        KILL AG("X")

 +8        QUIT 

REGEN     ;EP - (from option) - Regenerate old tape.

 +1        SET AGTXSITE=$PIECE(^AUTTSITE(1,0),"^")

 +2        IF '$DATA(^AGTXST(AGTXSITE))

               WRITE !,*7,"No export records for this facility.",!

               GOTO ENTRETRN^AGTX4

 +3        SET DIC="^AGTXST(AGTXSITE,1,"

           SET DIC(0)="AEFMQZ"

           SET D="B"

           SET DZ="??"

           DO DQ^DICQ

           DO ^DIC

           KILL DIC,D,DZ

           IF Y<1

               QUIT 

 +4        SET AG("REGEN")=Y(0)

 +5        GOTO AGTX

TEST      ;EP - Test a transmission with a small date range

 +1        SET %DT="AE"

           SET %DT("A")="Start date: "

           DO ^%DT

           IF Y'>0

               QUIT 

           SET AGBDT=Y

 +2        SET %DT="AE"

           SET %DT("A")="Stop date: "

           SET %DT(0)=Y

           DO ^%DT

           IF Y'>0

               QUIT 

           SET AGEDT=Y

 +3        KILL %DT(0)

 +4        SET AG("REGEN")="^"_AGBDT_"^"_AGEDT

 +5        SET AGBDT=AGBDT

           SET AGEDT=AGEDT+.9

 +6        SET AGLO="^AGPATCH("_AGBDT_")"

           FOR 

               SET AGLO=$QUERY(@AGLO)

               IF (AGLO=""!(AGLO["ER"))

                   QUIT 

               SET AGDT=$PIECE(AGLO,"(",2)

               SET AGDT=$PIECE(AGDT,",")

               IF (AGDT>AGEDT)

                   QUIT 

               WRITE !,AGLO," = ",@AGLO

 +7        KILL AGBDT,AGEDT

 +8        WRITE !,"EXITING WILL KILL AG(""REGEN"")",!

 +9        SET DIR(0)="E"

           DO ^DIR

           IF X["^"

               KILL AG("REGEN")

               QUIT 

 +10       GOTO AGTX