[613] | 1 | VAFCTFU1 ;BHM/RGY-Utilities for the Treating Facility file 391.91, CONTINUED ;10/31/99
|
---|
| 2 | ;;5.3;Registration;**261,392,448,449**;Aug 13, 1993
|
---|
| 3 | TFL(LIST,DFN) ;for dfn get list of treating facilities
|
---|
| 4 | NEW X,ICN,DA,DR,VAFCTFU1,DIC,DIQ,VAFC
|
---|
| 5 | S X="MPIF001" X ^%ZOSF("TEST") I '$T S LIST(1)="-1^MPI Not Installed" Q
|
---|
| 6 | S DR=".01;13;99",DIC=4,DIQ(0)="E",DIQ="VAFCTFU1" ;**448
|
---|
| 7 | S ICN=$$GETICN^MPIF001(DFN)
|
---|
| 8 | I ICN<0 S LIST(1)=ICN Q
|
---|
| 9 | S X=$$QUERYTF($P(ICN,"V"),"LIST",0)
|
---|
| 10 | I $P(X,U)="1" S LIST(1)="-1"_U_$P(X,U,2) Q
|
---|
| 11 | F VAFC=0:0 S VAFC=$O(LIST(VAFC)) Q:VAFC="" D
|
---|
| 12 | .K VAFCTFU1
|
---|
| 13 | .S DA=+LIST(VAFC)
|
---|
| 14 | .D EN^DIQ1
|
---|
| 15 | .S LIST(VAFC)=VAFCTFU1(4,+LIST(VAFC),99,"E")_"^"_VAFCTFU1(4,+LIST(VAFC),.01,"E")_"^"_$P(LIST(VAFC),"^",2)_"^"_$P(LIST(VAFC),"^",3)_"^"_VAFCTFU1(4,+LIST(VAFC),13,"E") ;**448
|
---|
| 16 | .Q
|
---|
| 17 | Q
|
---|
| 18 | GETICN(RESULT,DFN) ;
|
---|
| 19 | S RESULT=$$GETICN^MPIF001(DFN)
|
---|
| 20 | Q
|
---|
| 21 | GETDFN(RESULT,ICN) ;
|
---|
| 22 | S RESULT=$$GETDFN^MPIF001(ICN)
|
---|
| 23 | Q
|
---|
| 24 | IFLOCAL(RESULT,DFN) ;
|
---|
| 25 | S RESULT=$$IFLOCAL^MPIF001(DFN)
|
---|
| 26 | Q
|
---|
| 27 | ;
|
---|
| 28 | SET(TFIEN,ARY,CTR) ;This sets the array with the treating facility list.
|
---|
| 29 | ; Returns: treating facility ^ treatment date ^ event reason (if any)
|
---|
| 30 | ; *261 gjc@120899 (formerly part of VAFCTFU prior to DG*5.3*261)
|
---|
| 31 | N DGCN S CTR=CTR+1,DGCN(0)=$G(^DGCN(391.91,TFIEN,0))
|
---|
| 32 | S @ARY@(CTR)=$P(DGCN(0),U,2,3)_U_$P(DGCN(0),U,7)
|
---|
| 33 | Q
|
---|
| 34 | ;
|
---|
| 35 | QUERYTF(PAT,ARY,INDX) ;a query for Treating Facility.
|
---|
| 36 | ;INPUT PAT - The patient's ICN
|
---|
| 37 | ; ARY - The array in which to return the Treating facility info.
|
---|
| 38 | ; INDX (optional) - the index to $O through. APAT for patient
|
---|
| 39 | ; information linked to treating facilities, AEVN for patient
|
---|
| 40 | ; info linked with an event reason. INDX=1 if AEVN is used,
|
---|
| 41 | ; else APAT is used. *261 gjc@120399
|
---|
| 42 | ;
|
---|
| 43 | ;OUTPUT A list of the Treating Facilities in the array provided from
|
---|
| 44 | ; the parameter. It will be in the structure of x(1), x(2) etc.
|
---|
| 45 | ; Ex X(1)=500^2960101^ptr to ADT/HL7 Event Reason file (if exists)
|
---|
| 46 | ; Where the first piece is the IEN of the institution, the second
|
---|
| 47 | ; piece is the current date on record for that institution and the
|
---|
| 48 | ; third piece is the event reason (if it exists). Note: A04 & A08
|
---|
| 49 | ; events do not file an event reason when adding to the TREATING
|
---|
| 50 | ; FACILITY LIST (#391.91) file, thus returning null in the third
|
---|
| 51 | ; piece. *261 gjc@120199
|
---|
| 52 | ;
|
---|
| 53 | ; This is also a function call. If there is an error then a
|
---|
| 54 | ; 1^error description will be returned.
|
---|
| 55 | ;
|
---|
| 56 | ; *** If no data is found the array will not be populated and
|
---|
| 57 | ; a 1^error description will be returned.
|
---|
| 58 | ;
|
---|
| 59 | N PDFN,VAFCER,LP,CTR
|
---|
| 60 | I '$G(PAT)!('$D(ARY)) S VAFCER="1^Parameter missing." G QUERYTFQ
|
---|
| 61 | S VAFCER=0,CTR=0,INDX=$G(INDX)
|
---|
| 62 | S X="MPIF001" X ^%ZOSF("TEST") I '$T G QUERYTFQ
|
---|
| 63 | S PDFN=$$GETDFN^MPIF001(PAT)
|
---|
| 64 | I PDFN<0 S VAFCER="1^No patient DFN." G QUERYTFQ
|
---|
| 65 | ; determine the index to $O through, based on the value of INDX
|
---|
| 66 | I 'INDX F LP=0:0 S LP=$O(^DGCN(391.91,"APAT",PDFN,LP)) Q:'LP S TFIEN=$O(^(LP,"")) D SET(TFIEN,ARY,.CTR)
|
---|
| 67 | I INDX S LP=0 F S LP=$O(^DGCN(391.91,"AEVN",PDFN,LP)) Q:'LP D
|
---|
| 68 | .; please note the following: the AEVN xref is subscripted by pat. dfn
|
---|
| 69 | .; event reason ptr, and the ien of the TFL file. It is possible
|
---|
| 70 | .; that a patient may have numerous admission/discharges at different
|
---|
| 71 | .; treating facilities, thus the looping through the TFIEN (TFL ien)
|
---|
| 72 | .; subscript. *261 gjc@120399
|
---|
| 73 | .S TFIEN=0 F S TFIEN=$O(^DGCN(391.91,"AEVN",PDFN,LP,TFIEN)) Q:'TFIEN D SET(TFIEN,ARY,.CTR)
|
---|
| 74 | .Q
|
---|
| 75 | I $D(@ARY)'>9 S VAFCER="1^Could not find Treating Facilities"
|
---|
| 76 | QUERYTFQ Q VAFCER
|
---|