AGTX4.m

AGTX4 ; IHS/ASDS/EFG - EXPORT REG DATA CONT'D ;  

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

JOBEND ;EP - EOJ, Process and mark deletes, DISPLAY RECORD COUNTS ETC.

 ; send deletes to DDPS (AGNODE is to be the complete RG3 ready to send) ie RG3^ASUFAC^HRN^^LastIntFirstInt^Sex

 I $D(^AGPATCH("DEL")) S AGNODE="" F  S AGNODE=$O(^AGPATCH("DEL",AGNODE)) Q:AGNODE=""  S ^AGPATCH("DEL",AGNODE)=1 D

 .I '$D(ZTQUEUED) W:AGOUTFLG !,AGNODE I 'AGOUTFLG,AGROUT#10=0 X XY W AGROUT

 .S AGROUT=AGROUT+1,AGNODE=$P(AGNODE,U,1)_U_$$UID^AGTXID(0)_U_$P(AGNODE,U,2,999),$P(AGNODE,U,9)=$P(AGNODE,U,9),^AGTXDATA(AGROUT)=AGNODE,AG("TOT")=$G(AG("TOT"))+1

 K AGNODE

 D HEADER^AGTX

 S AG("T")=0,AG("N")=0 F AG("T")=0:1 S AG("N")=$O(^AGCHDFN(AG("N"))) Q:AG("N")'>0

ALL ;EP - From AGTXALL.

 W !!?10,"NUMBER OF PATIENTS BEING SENT     = ",$J(AG("T"),5)

 W !!?10,"NUMBER OF PATIENT RECORDS TO SEND = ",$J(AG("TOT"),5)

 W !?10,"            TOTAL RECORDS TO SEND = ",$J(AG("T")+AG("TOT"),5)

 W !!?10,"NUMBER OF BLANK ADDRESS RECORDS   = ",$J(AGBAD16,5)

 W !!?10,"NUMBER OF BLANK COMMUNITY         = ",$J(AGBAD51,5)

 I AGROUT<1 W !!,*7,?10,"NO RECORDS GENERATED FOR EXPORT" G KILL

SETZERO ;Set 0th node.

 N AGASUFAC,AGSITE,AGDATE

 S AGASUFAC=$P(^AUTTLOC(AGTXSITE,0),U,10)

 S AGSITE=$P(^DIC(4,AGTXSITE,0),U)

 S AGDATE=DT+17000000

 I $D(AGFDATE) S AGFDATE=AGFDATE+17000000

 I $D(AGLDATE) S AGLDATE=AGLDATE+17000000

 S ^AGTXDATA(0)=AGASUFAC_U_AGSITE_U_AGDATE_U_AGFDATE_U_AGLDATE_"^^"_AGROUT_U

 I $D(AGLDATE) S AGLDATE=AGLDATE-17000000

 I $D(AGFDATE) S AGFDATE=AGFDATE-17000000

 G:$D(AG("REGEN")) W1

 D SET^AGTXST ;set data into transmission file

W1 ;

 W !!?17,"REGISTRATION EXPORT GLOBAL HAS BEEN GENERATED." D:'$G(AGTXALL) ^AGTXTOT,^AGTXERP G KILL

ENTRETRN ;EP -

 K DIR S DIR(0)="E" D ^DIR K DIR

KILL K AGELGEND,AGTX,AGTXRGSV,AGBAD16,AGBAD26,AGBAD51,AGCC,AGCT,DA,AGDFN16,AGDFN51,DIC,DR,DX,DY,AGFDATE,AGFN,G,AGL,AGLDATE,AG("LKDATA"),AG("LKPRINT")

 K AGLN,AGMN,AGN1,AGN2,AGN3,AGNAME,AGNI,AGNUMB,AGOUTFLG,AGR1,AGR2,AGRCT,AGROUT,AGRR,AGRR1,AG("SITE"),AGTEMP,AGVAL,X,AGXN,XX,Y,Z

 Q

AGTX4     ; IHS/ASDS/EFG - EXPORT REG DATA CONT'D ;  

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

JOBEND    ;EP - EOJ, Process and mark deletes, DISPLAY RECORD COUNTS ETC.

 +1       ; send deletes to DDPS (AGNODE is to be the complete RG3 ready to send) ie RG3^ASUFAC^HRN^^LastIntFirstInt^Sex

 +2        IF $DATA(^AGPATCH("DEL"))

               SET AGNODE=""

               FOR 

                   SET AGNODE=$ORDER(^AGPATCH("DEL",AGNODE))

                   IF AGNODE=""

                       QUIT 

                   SET ^AGPATCH("DEL",AGNODE)=1

                   Begin DoDot:1

 +3                    IF '$DATA(ZTQUEUED)

                           IF AGOUTFLG

                               WRITE !,AGNODE

                           IF 'AGOUTFLG

                               IF AGROUT#10=0

                                   XECUTE XY

                                   WRITE AGROUT

 +4                    SET AGROUT=AGROUT+1

                       SET AGNODE=$PIECE(AGNODE,U,1)_U_$$UID^AGTXID(0)_U_$PIECE(AGNODE,U,2,999)

                       SET $PIECE(AGNODE,U,9)=$PIECE(AGNODE,U,9)

                       SET ^AGTXDATA(AGROUT)=AGNODE

                       SET AG("TOT")=$GET(AG("TOT"))+1

                   End DoDot:1

 +5        KILL AGNODE

 +6        DO HEADER^AGTX

 +7        SET AG("T")=0

           SET AG("N")=0

           FOR AG("T")=0:1

               SET AG("N")=$ORDER(^AGCHDFN(AG("N")))

               IF AG("N")'>0

                   QUIT 

ALL       ;EP - From AGTXALL.

 +1        WRITE !!?10,"NUMBER OF PATIENTS BEING SENT     = ",$JUSTIFY(AG("T"),5)

 +2        WRITE !!?10,"NUMBER OF PATIENT RECORDS TO SEND = ",$JUSTIFY(AG("TOT"),5)

 +3        WRITE !?10,"            TOTAL RECORDS TO SEND = ",$JUSTIFY(AG("T")+AG("TOT"),5)

 +4        WRITE !!?10,"NUMBER OF BLANK ADDRESS RECORDS   = ",$JUSTIFY(AGBAD16,5)

 +5        WRITE !!?10,"NUMBER OF BLANK COMMUNITY         = ",$JUSTIFY(AGBAD51,5)

 +6        IF AGROUT<1

               WRITE !!,*7,?10,"NO RECORDS GENERATED FOR EXPORT"

               GOTO KILL

SETZERO   ;Set 0th node.

 +1        NEW AGASUFAC,AGSITE,AGDATE

 +2        SET AGASUFAC=$PIECE(^AUTTLOC(AGTXSITE,0),U,10)

 +3        SET AGSITE=$PIECE(^DIC(4,AGTXSITE,0),U)

 +4        SET AGDATE=DT+17000000

 +5        IF $DATA(AGFDATE)

               SET AGFDATE=AGFDATE+17000000

 +6        IF $DATA(AGLDATE)

               SET AGLDATE=AGLDATE+17000000

 +7        SET ^AGTXDATA(0)=AGASUFAC_U_AGSITE_U_AGDATE_U_AGFDATE_U_AGLDATE_"^^"_AGROUT_U

 +8        IF $DATA(AGLDATE)

               SET AGLDATE=AGLDATE-17000000

 +9        IF $DATA(AGFDATE)

               SET AGFDATE=AGFDATE-17000000

 +10       IF $DATA(AG("REGEN"))

               GOTO W1

 +11      ;set data into transmission file

           DO SET^AGTXST

W1        ;

 +1        WRITE !!?17,"REGISTRATION EXPORT GLOBAL HAS BEEN GENERATED."

           IF '$GET(AGTXALL)

               DO ^AGTXTOT

               DO ^AGTXERP

           GOTO KILL

ENTRETRN  ;EP -

 +1        KILL DIR

           SET DIR(0)="E"

           DO ^DIR

           KILL DIR

KILL       KILL AGELGEND,AGTX,AGTXRGSV,AGBAD16,AGBAD26,AGBAD51,AGCC,AGCT,DA,AGDFN16,AGDFN51,DIC,DR,DX,DY,AGFDATE,AGFN,G,AGL,AGLDATE,AG("LKDATA"),AG("LKPRINT")

 +1        KILL AGLN,AGMN,AGN1,AGN2,AGN3,AGNAME,AGNI,AGNUMB,AGOUTFLG,AGR1,AGR2,AGRCT,AGROUT,AGRR,AGRR1,AG("SITE"),AGTEMP,AGVAL,X,AGXN,XX,Y,Z

 +2        QUIT