Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: AZAXHRN

AZAXHRN.m

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