- 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
- 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
- +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
