- 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
