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

VAFEOHL2.m

Go to the documentation of this file.
  1. VAFEOHL2 ;ALB/JLU/CAW;generates the HL7 message to be sent(con't);6/29/93
  1. ;;5.3;Registration;**38**;Aug 13, 1993
  1. ;
  1. ORC ;sets up the ORC segment and the fields 1 to indicate if new or canceled
  1. N VAFEDHL
  1. S VAFEDLCT=VAFEDLCT+1
  1. S $P(VAFEDHL,HLFS,1)="ORC"
  1. S $P(VAFEDHL,HLFS,2)=$S($P(VAFEDST1,"^",3)="C":"CA",1:"NW")
  1. D LOG^VAFEDOHL
  1. Q
  1. ;
  1. OBR ;sets up the OBR segment and the fields 4,7,8,9,14,22
  1. N VAFEDHL
  1. S VAFEDLCT=VAFEDLCT+1
  1. S $P(VAFEDHL,HLFS,1)="OBR"
  1. S $P(VAFEDHL,HLFS,5)=VAFEDDA_$E(HLECH)_"391.51"_$E(HLECH)_"L"
  1. S $P(VAFEDHL,HLFS,8)=$$HLDATE^HLFNC($P(VAFEDST1,U,1))
  1. S $P(VAFEDHL,HLFS,9)=HLQ
  1. S $P(VAFEDHL,HLFS,10)=HLQ
  1. S $P(VAFEDHL,HLFS,15)=HLQ
  1. S $P(VAFEDHL,HLFS,23)=$$HLDATE^HLFNC(VAFEDLP)
  1. D LOG^VAFEDOHL
  1. Q
  1. ;
  1. OBX ;this subroutine set up the OBX segments and the fields 3,5
  1. N X,VAFEDOBX
  1. S VAFEDOBX=0
  1. I +$P($G(VAFEDDX(1)),U) D DIAG
  1. I VAFEDST2]"" D CPT
  1. Q
  1. ;
  1. DIAG ;this subroutine will set up the diagnosics in the OBX.
  1. N VAFEDN,X,VAFEDD,I
  1. S VAFEDN=+$P(VAFEDDX(1),U)
  1. F X=2:1 S VAFEDC=$P(VAFEDDX(1),U,X) Q:'VAFEDC DO
  1. .S Y=$O(^ICD9("BA",VAFEDC,0))
  1. .Q:'Y I '$D(^ICD9(Y,0)) Q
  1. .S VAFEDD=$P(^ICD9(Y,0),U,3)
  1. .S VAFEDOBX=VAFEDOBX+1,VAFEDLCT=VAFEDLCT+1
  1. .S VAFEDHL="OBX"_HLFS_VAFEDOBX_HLFS_"CE"_HLFS_VAFEDC_$E(HLECH)_VAFEDD_$E(HLECH)_"I9"_HLFS_HLFS_HLQ
  1. .D LOG^VAFEDOHL
  1. I $D(VAFEDDX(2)) S I=1 F S I=$O(VAFEDDX(I)) Q:'I D
  1. .F X=2:1 S VAFEDC=$P(VAFEDDX(I),U,X) Q:'VAFEDC DO
  1. ..S Y=$O(^ICD9("BA",VAFEDC,0))
  1. ..Q:'Y I '$D(^ICD9(Y,0)) Q
  1. ..S VAFEDD=$P(^ICD9(Y,0),U,3)
  1. ..S VAFEDOBX=VAFEDOBX+1,VAFEDLCT=VAFEDLCT+1
  1. ..S VAFEDHL="OBX"_HLFS_VAFEDOBX_HLFS_"CE"_HLFS_VAFEDC_$E(HLECH)_VAFEDD_$E(HLECH)_"I9"_HLFS_HLFS_HLQ
  1. ..D LOG^VAFEDOHL
  1. Q
  1. ;
  1. CPT ;this subroutine will set up the OBX with CPT codes.
  1. N X,VAFEDC,VAFEDD
  1. F X=1:1 S VAFEDC=$P(VAFEDST2,U,X) Q:'VAFEDC DO
  1. .S Y=$O(^ICPT("B",VAFEDC,0))
  1. .Q:'Y I '$D(^ICPT(Y,0)) Q
  1. .S VAFEDD=$P(^ICPT(Y,0),U,2)
  1. .S VAFEDOBX=VAFEDOBX+1,VAFEDLCT=VAFEDLCT+1
  1. .S VAFEDHL="OBX"_HLFS_VAFEDOBX_HLFS_"CE"_HLFS_VAFEDC_$E(HLECH)_VAFEDD_$E(HLECH)_"AS4"_HLFS_HLFS_HLQ
  1. .D LOG^VAFEDOHL
  1. Q