| [613] | 1 | VAFEOHL2 ;ALB/JLU/CAW;generates the HL7 message to be sent(con't);6/29/93
|
|---|
| 2 | ;;5.3;Registration;**38**;Aug 13, 1993
|
|---|
| 3 | ;
|
|---|
| 4 | ORC ;sets up the ORC segment and the fields 1 to indicate if new or canceled
|
|---|
| 5 | N VAFEDHL
|
|---|
| 6 | S VAFEDLCT=VAFEDLCT+1
|
|---|
| 7 | S $P(VAFEDHL,HLFS,1)="ORC"
|
|---|
| 8 | S $P(VAFEDHL,HLFS,2)=$S($P(VAFEDST1,"^",3)="C":"CA",1:"NW")
|
|---|
| 9 | D LOG^VAFEDOHL
|
|---|
| 10 | Q
|
|---|
| 11 | ;
|
|---|
| 12 | OBR ;sets up the OBR segment and the fields 4,7,8,9,14,22
|
|---|
| 13 | N VAFEDHL
|
|---|
| 14 | S VAFEDLCT=VAFEDLCT+1
|
|---|
| 15 | S $P(VAFEDHL,HLFS,1)="OBR"
|
|---|
| 16 | S $P(VAFEDHL,HLFS,5)=VAFEDDA_$E(HLECH)_"391.51"_$E(HLECH)_"L"
|
|---|
| 17 | S $P(VAFEDHL,HLFS,8)=$$HLDATE^HLFNC($P(VAFEDST1,U,1))
|
|---|
| 18 | S $P(VAFEDHL,HLFS,9)=HLQ
|
|---|
| 19 | S $P(VAFEDHL,HLFS,10)=HLQ
|
|---|
| 20 | S $P(VAFEDHL,HLFS,15)=HLQ
|
|---|
| 21 | S $P(VAFEDHL,HLFS,23)=$$HLDATE^HLFNC(VAFEDLP)
|
|---|
| 22 | D LOG^VAFEDOHL
|
|---|
| 23 | Q
|
|---|
| 24 | ;
|
|---|
| 25 | OBX ;this subroutine set up the OBX segments and the fields 3,5
|
|---|
| 26 | N X,VAFEDOBX
|
|---|
| 27 | S VAFEDOBX=0
|
|---|
| 28 | I +$P($G(VAFEDDX(1)),U) D DIAG
|
|---|
| 29 | I VAFEDST2]"" D CPT
|
|---|
| 30 | Q
|
|---|
| 31 | ;
|
|---|
| 32 | DIAG ;this subroutine will set up the diagnosics in the OBX.
|
|---|
| 33 | N VAFEDN,X,VAFEDD,I
|
|---|
| 34 | S VAFEDN=+$P(VAFEDDX(1),U)
|
|---|
| 35 | F X=2:1 S VAFEDC=$P(VAFEDDX(1),U,X) Q:'VAFEDC DO
|
|---|
| 36 | .S Y=$O(^ICD9("BA",VAFEDC,0))
|
|---|
| 37 | .Q:'Y I '$D(^ICD9(Y,0)) Q
|
|---|
| 38 | .S VAFEDD=$P(^ICD9(Y,0),U,3)
|
|---|
| 39 | .S VAFEDOBX=VAFEDOBX+1,VAFEDLCT=VAFEDLCT+1
|
|---|
| 40 | .S VAFEDHL="OBX"_HLFS_VAFEDOBX_HLFS_"CE"_HLFS_VAFEDC_$E(HLECH)_VAFEDD_$E(HLECH)_"I9"_HLFS_HLFS_HLQ
|
|---|
| 41 | .D LOG^VAFEDOHL
|
|---|
| 42 | I $D(VAFEDDX(2)) S I=1 F S I=$O(VAFEDDX(I)) Q:'I D
|
|---|
| 43 | .F X=2:1 S VAFEDC=$P(VAFEDDX(I),U,X) Q:'VAFEDC DO
|
|---|
| 44 | ..S Y=$O(^ICD9("BA",VAFEDC,0))
|
|---|
| 45 | ..Q:'Y I '$D(^ICD9(Y,0)) Q
|
|---|
| 46 | ..S VAFEDD=$P(^ICD9(Y,0),U,3)
|
|---|
| 47 | ..S VAFEDOBX=VAFEDOBX+1,VAFEDLCT=VAFEDLCT+1
|
|---|
| 48 | ..S VAFEDHL="OBX"_HLFS_VAFEDOBX_HLFS_"CE"_HLFS_VAFEDC_$E(HLECH)_VAFEDD_$E(HLECH)_"I9"_HLFS_HLFS_HLQ
|
|---|
| 49 | ..D LOG^VAFEDOHL
|
|---|
| 50 | Q
|
|---|
| 51 | ;
|
|---|
| 52 | CPT ;this subroutine will set up the OBX with CPT codes.
|
|---|
| 53 | N X,VAFEDC,VAFEDD
|
|---|
| 54 | F X=1:1 S VAFEDC=$P(VAFEDST2,U,X) Q:'VAFEDC DO
|
|---|
| 55 | .S Y=$O(^ICPT("B",VAFEDC,0))
|
|---|
| 56 | .Q:'Y I '$D(^ICPT(Y,0)) Q
|
|---|
| 57 | .S VAFEDD=$P(^ICPT(Y,0),U,2)
|
|---|
| 58 | .S VAFEDOBX=VAFEDOBX+1,VAFEDLCT=VAFEDLCT+1
|
|---|
| 59 | .S VAFEDHL="OBX"_HLFS_VAFEDOBX_HLFS_"CE"_HLFS_VAFEDC_$E(HLECH)_VAFEDD_$E(HLECH)_"AS4"_HLFS_HLFS_HLQ
|
|---|
| 60 | .D LOG^VAFEDOHL
|
|---|
| 61 | Q
|
|---|
