| 1 | VAFEDOHL ;ALB/JLU/CAW;generates the HL7 message to be sent;6/29/93
|
|---|
| 2 | ;;5.3;Registration;**38**;Aug 13, 1993
|
|---|
| 3 | EN DO
|
|---|
| 4 | .D DATE
|
|---|
| 5 | .I '$$CHK(VAFEDDT) Q
|
|---|
| 6 | .D HL
|
|---|
| 7 | .I $D(HLERR) Q
|
|---|
| 8 | .D SETUP
|
|---|
| 9 | D EXOHL^VAFEDUTL
|
|---|
| 10 | Q
|
|---|
| 11 | ;
|
|---|
| 12 | DATE ;this subroutine gets the date to start from.
|
|---|
| 13 | S %DT="",X="T-1"
|
|---|
| 14 | D ^%DT
|
|---|
| 15 | S:'$D(VAFEDDT) VAFEDDT=Y_.9
|
|---|
| 16 | K Y,X
|
|---|
| 17 | Q
|
|---|
| 18 | ;
|
|---|
| 19 | CHK(VAFEDDT) ;this subroutine checks for the existance of data in the 391.51
|
|---|
| 20 | ;file.
|
|---|
| 21 | N X
|
|---|
| 22 | S X=$O(^VAT(391.51,"ABDC",0))
|
|---|
| 23 | DO
|
|---|
| 24 | .I 'X S X=0 Q
|
|---|
| 25 | .I X>VAFEDDT S X=0 Q
|
|---|
| 26 | .S X=1 Q
|
|---|
| 27 | Q X
|
|---|
| 28 | ;
|
|---|
| 29 | HL ;this subroutine sets up HL7 variables.
|
|---|
| 30 | ;init of hltrans may return an error HLERR
|
|---|
| 31 | S HLEVN=0
|
|---|
| 32 | S HLNDAP="EDR-MAS"
|
|---|
| 33 | D NOW^%DTC
|
|---|
| 34 | S HLSDT=%
|
|---|
| 35 | S HLMTN="ORU"
|
|---|
| 36 | K ^TMP("HLS",$J),%H,%I,%
|
|---|
| 37 | D INIT^HLTRANS
|
|---|
| 38 | Q
|
|---|
| 39 | ;
|
|---|
| 40 | SETUP ;starts the looping to get the info from the 391.51 file.
|
|---|
| 41 | S VAFEDLCT=0
|
|---|
| 42 | N VAFEDLP,X1,DFN,VAFEDD,VAFEDT
|
|---|
| 43 | F VAFEDLP=0:0 S VAFEDLP=$O(^VAT(391.51,"ABDC",VAFEDLP)) Q:'VAFEDLP!(VAFEDLP>VAFEDDT) F DFN=0:0 S DFN=$O(^VAT(391.51,"ABDC",VAFEDLP,DFN)) Q:'DFN D SET
|
|---|
| 44 | Q
|
|---|
| 45 | ;
|
|---|
| 46 | SET ;second layer of the loop.
|
|---|
| 47 | K VA,VADM,VAPA,VAERR
|
|---|
| 48 | D DEM^VADPT,ADD^VADPT
|
|---|
| 49 | I VADM(1)]"" DO
|
|---|
| 50 | .I 'HLEVN DO
|
|---|
| 51 | ..I '$D(HLDA) D FILE^HLTF
|
|---|
| 52 | ..S ^TMP("HLS",$J,HLSDT,0)=$$BHS^HLFNC1(HLMTN)
|
|---|
| 53 | .F VAFEDD=0:0 S VAFEDD=$O(^VAT(391.51,"ABDC",VAFEDLP,DFN,VAFEDD)) Q:'VAFEDD F VAFEDT=98,99 S VAFEDDA=$O(^VAT(391.51,"ABDC",VAFEDLP,DFN,VAFEDD,VAFEDT,0)) D:VAFEDDA BUILD I HLEVN>99 D SEND DO
|
|---|
| 54 | ..I '$D(HLDA) D FILE^HLTF
|
|---|
| 55 | ..S ^TMP("HLS",$J,HLSDT,0)=$$BHS^HLFNC1(HLMTN)
|
|---|
| 56 | Q
|
|---|
| 57 | ;
|
|---|
| 58 | BUILD ;this subroutine builds the HL7 messages segments
|
|---|
| 59 | S VAFEDST1=$G(^VAT(391.51,VAFEDDA,100)) I VAFEDDA]"" S VAFEDST2=$G(^VAT(391.51,VAFEDDA,200)),VAFELIG=$P($G(^VAT(391.51,VAFEDDA,0)),U,7) D:$G(^(150,1,0)) DSTR DO
|
|---|
| 60 | .S HLEVN=HLEVN+1
|
|---|
| 61 | .D MSH^VAFEOHL1
|
|---|
| 62 | .D PID^VAFEOHL1
|
|---|
| 63 | .D ZEL^VAFEOHL1
|
|---|
| 64 | .D PV1^VAFEOHL1
|
|---|
| 65 | .D ORC^VAFEOHL2
|
|---|
| 66 | .D OBR^VAFEOHL2
|
|---|
| 67 | .D OBX^VAFEOHL2
|
|---|
| 68 | .S $P(^VAT(391.51,VAFEDDA,0),"^",5)=HLDA
|
|---|
| 69 | Q
|
|---|
| 70 | ;
|
|---|
| 71 | LOG ;sets the HL7 string into the TMP global
|
|---|
| 72 | S ^TMP("HLS",$J,HLSDT,VAFEDLCT)=VAFEDHL
|
|---|
| 73 | Q
|
|---|
| 74 | ;
|
|---|
| 75 | SEND ;sends the HL7 message
|
|---|
| 76 | S VAFEDLCT=VAFEDLCT+1
|
|---|
| 77 | S VAFEDHL="BTS"_HLFS_HLEVN
|
|---|
| 78 | D LOG
|
|---|
| 79 | D EN1^HLTRANS
|
|---|
| 80 | D DELETE
|
|---|
| 81 | S (VAFEDLCT,HLEVN)=0
|
|---|
| 82 | Q
|
|---|
| 83 | ;
|
|---|
| 84 | DELETE ;deletes entries that were sent.
|
|---|
| 85 | N LP,Y
|
|---|
| 86 | F LP=0:0 S LP=$O(^VAT(391.51,LP)) Q:'LP S Y=$G(^(LP,0)) I $P(Y,U,5) DO
|
|---|
| 87 | .I '$D(HLERR) S DA=LP,DIK="^VAT(391.51," D ^DIK K DA,DIK Q
|
|---|
| 88 | .I $D(HLERR) S $P(^VAT(391.51,LP,0),U,5)=""
|
|---|
| 89 | K ^TMP("HLS",$J),HLDA,HLERR
|
|---|
| 90 | Q
|
|---|
| 91 | ;
|
|---|
| 92 | DSTR ;builds diagnosis string
|
|---|
| 93 | N I
|
|---|
| 94 | S I=0
|
|---|
| 95 | F S I=$O(^VAT(391.51,VAFEDDA,150,I)) Q:'I S VAFEDDX(I)=^(I,0)
|
|---|
| 96 | Q
|
|---|
