AZAXHRN ;IHS/PHXAO/AEF - HEALTH RECORD NUMBER HISTORICAL LOG
;;1.0;ANNE'S SPECIAL ROUTINES;;JUNE 30, 2004
;
;THIS ROUTINE IS USED TO READ THE CONTENTS OF THE REGISTRATION
;EXPORT FILES INTO A FILEMAN FILE SO THAT LOOKUPS AND REPORTS
;CAN BE DONE. THE HEALTH RECORD NUMBERS ARE STORED FOR HISTORICAL
;PURPOSES.
;
;
EN ;EP -- MAIN ENTRY POINT - USER INTERACTIVE
;
N ANS,FILE,OUT,PATH
;
D ^XBKVAR
D HOME^%ZIS
;
S OUT=0
;
D PF("PATH",.ANS,.OUT)
Q:OUT
S PATH=ANS
;
D PF("FILE",.ANS,.OUT)
Q:OUT
S FILE=ANS
;
D READ(PATH,FILE,.OUT)
Q:OUT
;
I '$O(^TMP("AZAX",$J,"HRNDATA",0)) D Q
. W !,"NO DATA FOUND"
;
I $G(^TMP("AZAX",$J,"HRNDATA",2,0))'["Registration Export Global" D Q
. W !,"This does not appear to be a REGISTRATION EXPORT file... "
. W !,"UNABLE TO PROCEED!"
. D KILL
;
D CHK(.OUT)
Q:OUT
;
D PROC(FILE)
;
D KILL
;
Q
PROC(FILE) ;
;----- PROCESS DATA IN ^TMP GLOBAL AND PUT INTO FM FILE
;
N AZAX,CNT,EXPDT,EXPFAC
;
W !,"Processing ^TMP global..."
;
S CNT=0
S EXPDT=$G(^TMP("AZAX",$J,"HRNDATA",1,0))
S EXPFAC=$P($G(^TMP("AZAX",$J,"HRNDATA",4,0)),U,2)
;
S AZAX=0
F S AZAX=$O(^TMP("AZAX",$J,"HRNDATA",AZAX)) Q:'AZAX D
. D ONE(AZAX,EXPDT,EXPFAC,FILE,.CNT)
;
W !,CNT," entries added to 'AZAX HRN HISTORICAL LOG' file"
;
Q
ONE(AZAX,EXPDT,EXPFAC,FILE,CNT) ;
;----- PROCESS ONE ENTRY
;
N ASUFAC,DA,DATA,DFN,DR,HRN,LOC,X,Y
;
S DATA=$G(^TMP("AZAX",$J,"HRNDATA",AZAX,0))
Q:$P(DATA,U)']""
Q:"RG1^RG4"'[$P(DATA,U)
;
S DA=+$$NEW
Q:DA'>0
;
S DFN=$$DFN($P(DATA,U,2))
I $P(DATA,U)="RG1" D
. S HRN=$P(DATA,U,4)
. S ASUFAC=$P(DATA,U,3)
I $P(DATA,U)="RG4" D
. S HRN=$P(DATA,U,10)
. S ASUFAC=$P(DATA,U,9)
S LOC=$$LOC(ASUFAC)
;
S DR=".02////^S X=DFN;.03///^S X=HRN;.04///^S X=ASUFAC;.05////^S X=LOC"
S DR=DR_";.07///^S X=EXPDT;.08///^S X=FILE;.09///^S X=EXPFAC"
;
D EDIT(DA,DR)
;
S CNT=CNT+1
I '(CNT#100) W "."
;
Q
EDIT(DA,DR) ;
;----- EDIT ENTRY
;
N DIE,X,Y
;
S DIE="^AZAX(1991288,"
D ^DIE
Q
DFN(X) ;
;----- RETURN PATIENT INTERNAL ENTRY NUMBER
;
; X = UNIQUE REGISTRATION ID FROM EXPORT FILE RECORD
;
N Y
S Y=""
I X D
. Q:$L(X)'=16
. S Y=+$E(X,7,16)
Q Y
;
LOC(X) ;
;----- RETURN LOCATION NAME
;
; X = ASUFAC CODE
;
N Y
S Y=""
I X D
. S Y=$O(^AUTTLOC("C",X,0))
. I Y S Y=$P($G(^DIC(4,Y,0)),U)
Q Y
;
NEW() ;
;----- CREATE NEW ENTRY IN AZAX HRN HISTORICAL LOG FILE
;
N DD,DIC,DLAYGO,DO,X,Y
L +^AZAX(1991288,0)
S X=$$NEXT
S DIC="^AZAX(1991288,"
S DLAYGO=1991288
S DIC(0)=""
D FILE^DICN
L -^AZAX(1991288,0)
Q Y
NEXT() ;
;----- RETURN NEXT IEN FROM AZAX HRN HISTORICAL LOG FILE
;
N Y
S Y=0
I $D(^AZAX(1991288,0)) D
. S Y=+$P($G(^AZAX(1991288,0)),U,3)
I $D(^AZAX(1991288,Y)) D
. F S Y=Y+1 Q:'$D(^AZAX(1991288,Y))
Q Y
;
PF(TXT,ANS,OUT) ;
;----- ASK PATH/FILE PROMPTS
;
N DIR,DIRUT,DTOUT,DUOUT,X,Y
;
S ANS=""
S DIR(0)="F"
I TXT="PATH" D
. S DIR("?")="EXAMPLE: 'c:\inetpub\ftproot\pub\' or '/usr/spool/uucppublic/'"
I TXT="FILE" D
. S DIR(0)=DIR(0)_"^^K:X'[""BGTX"" X"
. S DIR("?")="Select only Registration Export files beginning with 'BGTX'"
S DIR("A")="Select "_TXT
D ^DIR
I $D(DUOUT)!($D(DIRUT))!($D(DTOUT)) S OUT=1
Q:OUT
S ANS=Y
Q
READ(PATH,FILE,OUT) ;
;----- READ CONTENTS OF UNIX FILE AND PUT IN ^TMP("AZAX",$J,"HRNDATA" GLOBAL
;
N END,I,J,POP,X
;
K ^TMP("AZAX",$J,"HRNDATA")
S END=0
;
D OPEN^%ZISH("FILE",PATH,FILE,"R")
I POP D Q
. W !,"UNABLE TO OPEN FILE '"_PATH_FILE_"'"
. S OUT=1
;
U 0 W !,"Reading export file '",PATH_FILE,"'..."
;
F I=1:1 D Q:END
. U IO
. R X:DTIME
. I $$STATUS^%ZISH S END=1 Q
. F J="":1:31 S X=$TR(X,$C(J)) ;REMOVE ALL CONTROL CHARACTERS
. S ^TMP("AZAX",$J,"HRNDATA",I,0)=X
. S ^TMP("AZAX",$J,"HRNDATA",0)=$G(^TMP("AZAX",$J,"HRNDATA",0))+1
. I '(I#1000) U 0 W "."
D CLOSE^%ZISH("FILE")
W !,I," records added to ^TMP global"
Q
KILL ;
;----- KILL ^TMP("AZAX",$J,"HRNDATA") GLOBAL
;
K ^TMP("AZAX",$J,"HRNDATA")
Q
CNTDFN() ;
;----- COUNT THE NUMBER OF UNIQUE DFNS IN THE ^TMP GLOBAL
;
N CNT,X,Y
K DFN
S CNT=0
S X=0
F S X=$O(^TMP("AZAX",$J,"HRNDATA",X)) Q:'X D
. S Y=$G(^TMP("AZAX",$J,"HRNDATA",X,0))
. Q:$P(Y,U)'="RG1"
. S DFN=$P(Y,U,2)
. S DFN=+$E(DFN,7,16)
. Q:'DFN
. I '$D(DFN(DFN)) D
. . S DFN(DFN)=""
. . S CNT=CNT+1
Q CNT
CHK(OUT) ;
;----- CHECKS TO SEE IF FILE HAS ALREADY BEEN DOWNLOADED
;
N DIR,X,Y
;
S OUT=0
;
S X=$G(^TMP("AZAX",$J,"HRNDATA",1,0))
Q:X']""
S %DT="RSTX"
D ^%DT
Q:'$D(^AZAX(1991288,"AC",Y))
;
W !
S DIR(0)="Y"
S DIR("A",1)="WARNING!!! It appears that this file has already been downloaded"
S DIR("A",2)="Downloading it again may cause duplicate entries in your AZAX HRN"
S DIR("A",3)="HISTORICAL LOG file."
S DIR("A",4)=""
S DIR("A")="Are you SURE you want to download this file"
S DIR("B")="NO"
D ^DIR
I 'Y S OUT=1
Q
EN1 ;EP -- NON-USER INTERACTIVE ENTRY POINT
; LOOPS THROUGH EACH FILE IN 'FILES' AND EXTRACTS THE DATA
;
D ^XBKVAR
D HOME^%ZIS
S OUT=0
;
F I=1:1 D Q:OUT
. S TXT=$T(FILES+I)
. I TXT["$$END" S OUT=1
. Q:OUT
. S FILE=$P(TXT,";",6)
. Q:FILE'["BGTX"
. Q:FILE']""
. S PATH=$P(TXT,";",5)
. Q:PATH']""
. ;
. D READ(PATH,FILE,.OUT)
. Q:OUT
. Q:'$O(^TMP("AZAX",$J,"HRNDATA",0))
. Q:$G(^TMP("AZAX",$J,"HRNDATA",2,0))'["Registration Export Global"
. ;
. D PROC(FILE)
Q
CNT ;----- COUNT THE REUSED HRNS AT SAME SITE
;
N DFN,FAC,HRN,X,Y
;
K ^TMP("AZAX",$J)
;
S X=0
F S X=$O(^AZAX(1991288,X)) Q:'X D
. S Y=$G(^AZAX(1991288,X,0))
. S DFN=$P(Y,U,2)
. S HRN=$P(Y,U,3)
. S FAC=$P(Y,U,4)
. S ^TMP("AZAX",$J,"AHD",FAC,HRN,DFN)=""
;
S FAC=0
F S FAC=$O(^TMP("AZAX",$J,"AHD",FAC)) Q:'FAC D
. S HRN=0
. F S HRN=$O(^TMP("AZAX",$J,"AHD",FAC,HRN)) Q:'HRN D
. . S DFN=0
. . F S DFN=$O(^TMP("AZAX",$J,"AHD",FAC,HRN,DFN)) Q:'DFN D
. . . S ^TMP("AZAX",$J,"CNT",FAC,HRN)=$G(^TMP("AZAX",$J,"CNT",FAC,HRN))+1
;
S FAC=0
F S FAC=$O(^TMP("AZAX",$J,"CNT",FAC)) Q:'FAC D
. S HRN=0
. F S HRN=$O(^TMP("AZAX",$J,"CNT",FAC,HRN)) Q:'HRN D
. . Q:$G(^TMP("AZAX",$J,"CNT",FAC,HRN))=1
. . W !,"ASUFAC: "_FAC_" HRN: "_HRN_" = "_$G(^TMP("AZAX",$J,"CNT",FAC,HRN))
Q
PNAME(X) ;
;EP -- RETURN PATIENT NAME
; CALLED BY PATIENT NAME COMPUTED FIELD IN AZAX HRN HISTORICAL LOG FILE
;
N Y
S Y=""
I X S Y=$P($G(^AZAX(1991288,X,0)),U,2)
I Y S Y=$P($G(^DPT(Y,0)),U)
Q Y
FILES ;
;----- FILES CONTAINING PAT REG EXPORT DATA FROM PARKER
;;10-01 BASELINE;3011017;/usr5/exports/;BGTX606401.290
;;11-01;3011102;/usr5/exports/;BGTX606401.305
;;12-01;3011129;/usr5/exports/;BGTX606401.333
;;01-02;3020102;/usr5/exports/;BGTX606401.2
;;02-02;3020204;/usr5/exports/;BGTX606401.35
;;03-02;3020228;/usr5/exports/;BGTX606401.59
;;04-02;3020401;/usr5/exports/;BGTX606401.91
;;05-02;3020430;/usr5/exports/;BGTX606401.120
;;06-02;3020530;/usr5/exports/;BGTX606401.150
;;07-02;3020701;/usr5/exports/;BGTX606401.182
;;08-02;3020725;/usr5/exports/;BGTX606401.206
;;09-02;3020903;/usr5/exports/;BGTX606401.246
;;10-02;3021001;/usr5/exports/;BGTX606401.274
;;12-02;3021102;/usr5/exports/;BGTX606401.306
;;12-02;3021126;/usr5/exports/;BGTX606401.330
;;01-03;3021231;/usr5/2003/;BGTX606401.365
;;02-03;3020205;/usr5/2003/;BGTX606401.36
;;03-03;3020303;/usr5/2003/;BGTX606401.62
;;04-03;3030408;/usr5/2003/;BGTX606401.98
;;05-03;3030501;/usr5/2003/;BGTX606401.121
;;06-03;3030530;/usr5/jaysexports2003/;BGTX606401.150
;;07-03;3030627;/usr5/jaysexports2003/;BGTX606401.178
;;08-03;3030725;/usr5/jaysexports2003/;BGTX606401.206
;;08-03;3030731;/usr5/jaysexports2003/;BGTX606401.212
;;09-03;3030828;/usr5/jaysexports2003/;BGTX606401.240
;;10-03;3030930;/usr5/jaysexports2003/;BGTX606401.273
;;10-03;3031001;/usr5/jaysexports2003/;BGTX606401.274
;;11-03;3031103;/usr5/jaysexports2003/;BGTX606401.307
;;12-03;3031201;/usr5/jaysexports2003/;BGTX606401.335
;;01-04;3031231;/usr5/jaysexports2004/;BGTX606401.365
;;02-04;3040131;/usr5/jaysexports2004/;BGTX606401.31
;;03-04;3040301;/usr5/jaysexports2004/;BGTX606401.61
;;04-04;3040401;/usr5/jaysexports2004/;BGTX606401.92
;;05-04;3040430;/usr/spool/uucppublic/;BGTX606401.121
;;06-04;3040528;/usr/spool/uucppublic/;BGTX606401.149
;;$$END
AZAXHRN ;IHS/PHXAO/AEF - HEALTH RECORD NUMBER HISTORICAL LOG
+1 ;;1.0;ANNE'S SPECIAL ROUTINES;;JUNE 30, 2004
+2 ;
+3 ;THIS ROUTINE IS USED TO READ THE CONTENTS OF THE REGISTRATION
+4 ;EXPORT FILES INTO A FILEMAN FILE SO THAT LOOKUPS AND REPORTS
+5 ;CAN BE DONE. THE HEALTH RECORD NUMBERS ARE STORED FOR HISTORICAL
+6 ;PURPOSES.
+7 ;
+8 ;
EN ;EP -- MAIN ENTRY POINT - USER INTERACTIVE
+1 ;
+2 NEW ANS,FILE,OUT,PATH
+3 ;
+4 DO ^XBKVAR
+5 DO HOME^%ZIS
+6 ;
+7 SET OUT=0
+8 ;
+9 DO PF("PATH",.ANS,.OUT)
+10 IF OUT
QUIT
+11 SET PATH=ANS
+12 ;
+13 DO PF("FILE",.ANS,.OUT)
+14 IF OUT
QUIT
+15 SET FILE=ANS
+16 ;
+17 DO READ(PATH,FILE,.OUT)
+18 IF OUT
QUIT
+19 ;
+20 IF '$ORDER(^TMP("AZAX",$JOB,"HRNDATA",0))
Begin DoDot:1
+21 WRITE !,"NO DATA FOUND"
End DoDot:1
QUIT
+22 ;
+23 IF $GET(^TMP("AZAX",$JOB,"HRNDATA",2,0))'["Registration Export Global"
Begin DoDot:1
+24 WRITE !,"This does not appear to be a REGISTRATION EXPORT file... "
+25 WRITE !,"UNABLE TO PROCEED!"
+26 DO KILL
End DoDot:1
QUIT
+27 ;
+28 DO CHK(.OUT)
+29 IF OUT
QUIT
+30 ;
+31 DO PROC(FILE)
+32 ;
+33 DO KILL
+34 ;
+35 QUIT
PROC(FILE) ;
+1 ;----- PROCESS DATA IN ^TMP GLOBAL AND PUT INTO FM FILE
+2 ;
+3 NEW AZAX,CNT,EXPDT,EXPFAC
+4 ;
+5 WRITE !,"Processing ^TMP global..."
+6 ;
+7 SET CNT=0
+8 SET EXPDT=$GET(^TMP("AZAX",$JOB,"HRNDATA",1,0))
+9 SET EXPFAC=$PIECE($GET(^TMP("AZAX",$JOB,"HRNDATA",4,0)),U,2)
+10 ;
+11 SET AZAX=0
+12 FOR
SET AZAX=$ORDER(^TMP("AZAX",$JOB,"HRNDATA",AZAX))
IF 'AZAX
QUIT
Begin DoDot:1
+13 DO ONE(AZAX,EXPDT,EXPFAC,FILE,.CNT)
End DoDot:1
+14 ;
+15 WRITE !,CNT," entries added to 'AZAX HRN HISTORICAL LOG' file"
+16 ;
+17 QUIT
ONE(AZAX,EXPDT,EXPFAC,FILE,CNT) ;
+1 ;----- PROCESS ONE ENTRY
+2 ;
+3 NEW ASUFAC,DA,DATA,DFN,DR,HRN,LOC,X,Y
+4 ;
+5 SET DATA=$GET(^TMP("AZAX",$JOB,"HRNDATA",AZAX,0))
+6 IF $PIECE(DATA,U)']""
QUIT
+7 IF "RG1^RG4"'[$PIECE(DATA,U)
QUIT
+8 ;
+9 SET DA=+$$NEW
+10 IF DA'>0
QUIT
+11 ;
+12 SET DFN=$$DFN($PIECE(DATA,U,2))
+13 IF $PIECE(DATA,U)="RG1"
Begin DoDot:1
+14 SET HRN=$PIECE(DATA,U,4)
+15 SET ASUFAC=$PIECE(DATA,U,3)
End DoDot:1
+16 IF $PIECE(DATA,U)="RG4"
Begin DoDot:1
+17 SET HRN=$PIECE(DATA,U,10)
+18 SET ASUFAC=$PIECE(DATA,U,9)
End DoDot:1
+19 SET LOC=$$LOC(ASUFAC)
+20 ;
+21 SET DR=".02////^S X=DFN;.03///^S X=HRN;.04///^S X=ASUFAC;.05////^S X=LOC"
+22 SET DR=DR_";.07///^S X=EXPDT;.08///^S X=FILE;.09///^S X=EXPFAC"
+23 ;
+24 DO EDIT(DA,DR)
+25 ;
+26 SET CNT=CNT+1
+27 IF '(CNT#100)
WRITE "."
+28 ;
+29 QUIT
EDIT(DA,DR) ;
+1 ;----- EDIT ENTRY
+2 ;
+3 NEW DIE,X,Y
+4 ;
+5 SET DIE="^AZAX(1991288,"
+6 DO ^DIE
+7 QUIT
DFN(X) ;
+1 ;----- RETURN PATIENT INTERNAL ENTRY NUMBER
+2 ;
+3 ; X = UNIQUE REGISTRATION ID FROM EXPORT FILE RECORD
+4 ;
+5 NEW Y
+6 SET Y=""
+7 IF X
Begin DoDot:1
+8 IF $LENGTH(X)'=16
QUIT
+9 SET Y=+$EXTRACT(X,7,16)
End DoDot:1
+10 QUIT Y
+11 ;
LOC(X) ;
+1 ;----- RETURN LOCATION NAME
+2 ;
+3 ; X = ASUFAC CODE
+4 ;
+5 NEW Y
+6 SET Y=""
+7 IF X
Begin DoDot:1
+8 SET Y=$ORDER(^AUTTLOC("C",X,0))
+9 IF Y
SET Y=$PIECE($GET(^DIC(4,Y,0)),U)
End DoDot:1
+10 QUIT Y
+11 ;
NEW() ;
+1 ;----- CREATE NEW ENTRY IN AZAX HRN HISTORICAL LOG FILE
+2 ;
+3 NEW DD,DIC,DLAYGO,DO,X,Y
+4 LOCK +^AZAX(1991288,0)
+5 SET X=$$NEXT
+6 SET DIC="^AZAX(1991288,"
+7 SET DLAYGO=1991288
+8 SET DIC(0)=""
+9 DO FILE^DICN
+10 LOCK -^AZAX(1991288,0)
+11 QUIT Y
NEXT() ;
+1 ;----- RETURN NEXT IEN FROM AZAX HRN HISTORICAL LOG FILE
+2 ;
+3 NEW Y
+4 SET Y=0
+5 IF $DATA(^AZAX(1991288,0))
Begin DoDot:1
+6 SET Y=+$PIECE($GET(^AZAX(1991288,0)),U,3)
End DoDot:1
+7 IF $DATA(^AZAX(1991288,Y))
Begin DoDot:1
+8 FOR
SET Y=Y+1
IF '$DATA(^AZAX(1991288,Y))
QUIT
End DoDot:1
+9 QUIT Y
+10 ;
PF(TXT,ANS,OUT) ;
+1 ;----- ASK PATH/FILE PROMPTS
+2 ;
+3 NEW DIR,DIRUT,DTOUT,DUOUT,X,Y
+4 ;
+5 SET ANS=""
+6 SET DIR(0)="F"
+7 IF TXT="PATH"
Begin DoDot:1
+8 SET DIR("?")="EXAMPLE: 'c:\inetpub\ftproot\pub\' or '/usr/spool/uucppublic/'"
End DoDot:1
+9 IF TXT="FILE"
Begin DoDot:1
+10 SET DIR(0)=DIR(0)_"^^K:X'[""BGTX"" X"
+11 SET DIR("?")="Select only Registration Export files beginning with 'BGTX'"
End DoDot:1
+12 SET DIR("A")="Select "_TXT
+13 DO ^DIR
+14 IF $DATA(DUOUT)!($DATA(DIRUT))!($DATA(DTOUT))
SET OUT=1
+15 IF OUT
QUIT
+16 SET ANS=Y
+17 QUIT
READ(PATH,FILE,OUT) ;
+1 ;----- READ CONTENTS OF UNIX FILE AND PUT IN ^TMP("AZAX",$J,"HRNDATA" GLOBAL
+2 ;
+3 NEW END,I,J,POP,X
+4 ;
+5 KILL ^TMP("AZAX",$JOB,"HRNDATA")
+6 SET END=0
+7 ;
+8 DO OPEN^%ZISH("FILE",PATH,FILE,"R")
+9 IF POP
Begin DoDot:1
+10 WRITE !,"UNABLE TO OPEN FILE '"_PATH_FILE_"'"
+11 SET OUT=1
End DoDot:1
QUIT
+12 ;
+13 USE 0
WRITE !,"Reading export file '",PATH_FILE,"'..."
+14 ;
+15 FOR I=1:1
Begin DoDot:1
+16 USE IO
+17 READ X:DTIME
+18 IF $$STATUS^%ZISH
SET END=1
QUIT
+19 ;REMOVE ALL CONTROL CHARACTERS
FOR J="":1:31
SET X=$TRANSLATE(X,$CHAR(J))
+20 SET ^TMP("AZAX",$JOB,"HRNDATA",I,0)=X
+21 SET ^TMP("AZAX",$JOB,"HRNDATA",0)=$GET(^TMP("AZAX",$JOB,"HRNDATA",0))+1
+22 IF '(I#1000)
USE 0
WRITE "."
End DoDot:1
IF END
QUIT
+23 DO CLOSE^%ZISH("FILE")
+24 WRITE !,I," records added to ^TMP global"
+25 QUIT
KILL ;
+1 ;----- KILL ^TMP("AZAX",$J,"HRNDATA") GLOBAL
+2 ;
+3 KILL ^TMP("AZAX",$JOB,"HRNDATA")
+4 QUIT
CNTDFN() ;
+1 ;----- COUNT THE NUMBER OF UNIQUE DFNS IN THE ^TMP GLOBAL
+2 ;
+3 NEW CNT,X,Y
+4 KILL DFN
+5 SET CNT=0
+6 SET X=0
+7 FOR
SET X=$ORDER(^TMP("AZAX",$JOB,"HRNDATA",X))
IF 'X
QUIT
Begin DoDot:1
+8 SET Y=$GET(^TMP("AZAX",$JOB,"HRNDATA",X,0))
+9 IF $PIECE(Y,U)'="RG1"
QUIT
+10 SET DFN=$PIECE(Y,U,2)
+11 SET DFN=+$EXTRACT(DFN,7,16)
+12 IF 'DFN
QUIT
+13 IF '$DATA(DFN(DFN))
Begin DoDot:2
+14 SET DFN(DFN)=""
+15 SET CNT=CNT+1
End DoDot:2
End DoDot:1
+16 QUIT CNT
CHK(OUT) ;
+1 ;----- CHECKS TO SEE IF FILE HAS ALREADY BEEN DOWNLOADED
+2 ;
+3 NEW DIR,X,Y
+4 ;
+5 SET OUT=0
+6 ;
+7 SET X=$GET(^TMP("AZAX",$JOB,"HRNDATA",1,0))
+8 IF X']""
QUIT
+9 SET %DT="RSTX"
+10 DO ^%DT
+11 IF '$DATA(^AZAX(1991288,"AC",Y))
QUIT
+12 ;
+13 WRITE !
+14 SET DIR(0)="Y"
+15 SET DIR("A",1)="WARNING!!! It appears that this file has already been downloaded"
+16 SET DIR("A",2)="Downloading it again may cause duplicate entries in your AZAX HRN"
+17 SET DIR("A",3)="HISTORICAL LOG file."
+18 SET DIR("A",4)=""
+19 SET DIR("A")="Are you SURE you want to download this file"
+20 SET DIR("B")="NO"
+21 DO ^DIR
+22 IF 'Y
SET OUT=1
+23 QUIT
EN1 ;EP -- NON-USER INTERACTIVE ENTRY POINT
+1 ; LOOPS THROUGH EACH FILE IN 'FILES' AND EXTRACTS THE DATA
+2 ;
+3 DO ^XBKVAR
+4 DO HOME^%ZIS
+5 SET OUT=0
+6 ;
+7 FOR I=1:1
Begin DoDot:1
+8 SET TXT=$TEXT(FILES+I)
+9 IF TXT["$$END"
SET OUT=1
+10 IF OUT
QUIT
+11 SET FILE=$PIECE(TXT,";",6)
+12 IF FILE'["BGTX"
QUIT
+13 IF FILE']""
QUIT
+14 SET PATH=$PIECE(TXT,";",5)
+15 IF PATH']""
QUIT
+16 ;
+17 DO READ(PATH,FILE,.OUT)
+18 IF OUT
QUIT
+19 IF '$ORDER(^TMP("AZAX",$JOB,"HRNDATA",0))
QUIT
+20 IF $GET(^TMP("AZAX",$JOB,"HRNDATA",2,0))'["Registration Export Global"
QUIT
+21 ;
+22 DO PROC(FILE)
End DoDot:1
IF OUT
QUIT
+23 QUIT
CNT ;----- COUNT THE REUSED HRNS AT SAME SITE
+1 ;
+2 NEW DFN,FAC,HRN,X,Y
+3 ;
+4 KILL ^TMP("AZAX",$JOB)
+5 ;
+6 SET X=0
+7 FOR
SET X=$ORDER(^AZAX(1991288,X))
IF 'X
QUIT
Begin DoDot:1
+8 SET Y=$GET(^AZAX(1991288,X,0))
+9 SET DFN=$PIECE(Y,U,2)
+10 SET HRN=$PIECE(Y,U,3)
+11 SET FAC=$PIECE(Y,U,4)
+12 SET ^TMP("AZAX",$JOB,"AHD",FAC,HRN,DFN)=""
End DoDot:1
+13 ;
+14 SET FAC=0
+15 FOR
SET FAC=$ORDER(^TMP("AZAX",$JOB,"AHD",FAC))
IF 'FAC
QUIT
Begin DoDot:1
+16 SET HRN=0
+17 FOR
SET HRN=$ORDER(^TMP("AZAX",$JOB,"AHD",FAC,HRN))
IF 'HRN
QUIT
Begin DoDot:2
+18 SET DFN=0
+19 FOR
SET DFN=$ORDER(^TMP("AZAX",$JOB,"AHD",FAC,HRN,DFN))
IF 'DFN
QUIT
Begin DoDot:3
+20 SET ^TMP("AZAX",$JOB,"CNT",FAC,HRN)=$GET(^TMP("AZAX",$JOB,"CNT",FAC,HRN))+1
End DoDot:3
End DoDot:2
End DoDot:1
+21 ;
+22 SET FAC=0
+23 FOR
SET FAC=$ORDER(^TMP("AZAX",$JOB,"CNT",FAC))
IF 'FAC
QUIT
Begin DoDot:1
+24 SET HRN=0
+25 FOR
SET HRN=$ORDER(^TMP("AZAX",$JOB,"CNT",FAC,HRN))
IF 'HRN
QUIT
Begin DoDot:2
+26 IF $GET(^TMP("AZAX",$JOB,"CNT",FAC,HRN))=1
QUIT
+27 WRITE !,"ASUFAC: "_FAC_" HRN: "_HRN_" = "_$GET(^TMP("AZAX",$JOB,"CNT",FAC,HRN))
End DoDot:2
End DoDot:1
+28 QUIT
PNAME(X) ;
+1 ;EP -- RETURN PATIENT NAME
+2 ; CALLED BY PATIENT NAME COMPUTED FIELD IN AZAX HRN HISTORICAL LOG FILE
+3 ;
+4 NEW Y
+5 SET Y=""
+6 IF X
SET Y=$PIECE($GET(^AZAX(1991288,X,0)),U,2)
+7 IF Y
SET Y=$PIECE($GET(^DPT(Y,0)),U)
+8 QUIT Y
FILES ;
+1 ;----- FILES CONTAINING PAT REG EXPORT DATA FROM PARKER
+2 ;;10-01 BASELINE;3011017;/usr5/exports/;BGTX606401.290
+3 ;;11-01;3011102;/usr5/exports/;BGTX606401.305
+4 ;;12-01;3011129;/usr5/exports/;BGTX606401.333
+5 ;;01-02;3020102;/usr5/exports/;BGTX606401.2
+6 ;;02-02;3020204;/usr5/exports/;BGTX606401.35
+7 ;;03-02;3020228;/usr5/exports/;BGTX606401.59
+8 ;;04-02;3020401;/usr5/exports/;BGTX606401.91
+9 ;;05-02;3020430;/usr5/exports/;BGTX606401.120
+10 ;;06-02;3020530;/usr5/exports/;BGTX606401.150
+11 ;;07-02;3020701;/usr5/exports/;BGTX606401.182
+12 ;;08-02;3020725;/usr5/exports/;BGTX606401.206
+13 ;;09-02;3020903;/usr5/exports/;BGTX606401.246
+14 ;;10-02;3021001;/usr5/exports/;BGTX606401.274
+15 ;;12-02;3021102;/usr5/exports/;BGTX606401.306
+16 ;;12-02;3021126;/usr5/exports/;BGTX606401.330
+17 ;;01-03;3021231;/usr5/2003/;BGTX606401.365
+18 ;;02-03;3020205;/usr5/2003/;BGTX606401.36
+19 ;;03-03;3020303;/usr5/2003/;BGTX606401.62
+20 ;;04-03;3030408;/usr5/2003/;BGTX606401.98
+21 ;;05-03;3030501;/usr5/2003/;BGTX606401.121
+22 ;;06-03;3030530;/usr5/jaysexports2003/;BGTX606401.150
+23 ;;07-03;3030627;/usr5/jaysexports2003/;BGTX606401.178
+24 ;;08-03;3030725;/usr5/jaysexports2003/;BGTX606401.206
+25 ;;08-03;3030731;/usr5/jaysexports2003/;BGTX606401.212
+26 ;;09-03;3030828;/usr5/jaysexports2003/;BGTX606401.240
+27 ;;10-03;3030930;/usr5/jaysexports2003/;BGTX606401.273
+28 ;;10-03;3031001;/usr5/jaysexports2003/;BGTX606401.274
+29 ;;11-03;3031103;/usr5/jaysexports2003/;BGTX606401.307
+30 ;;12-03;3031201;/usr5/jaysexports2003/;BGTX606401.335
+31 ;;01-04;3031231;/usr5/jaysexports2004/;BGTX606401.365
+32 ;;02-04;3040131;/usr5/jaysexports2004/;BGTX606401.31
+33 ;;03-04;3040301;/usr5/jaysexports2004/;BGTX606401.61
+34 ;;04-04;3040401;/usr5/jaysexports2004/;BGTX606401.92
+35 ;;05-04;3040430;/usr/spool/uucppublic/;BGTX606401.121
+36 ;;06-04;3040528;/usr/spool/uucppublic/;BGTX606401.149
+37 ;;$$END
