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

APCLSIH1.m

Go to the documentation of this file.
  1. APCLSIH1 ;cmi/flag/maw - APCL ILI CDC HL7 Export 5/12/2010 9:26:17 AM
  1. ;;3.0;IHS PCC REPORTS;**29,30**;FEB 05, 1997;Build 27
  1. ;
  1. ;
  1. ;
  1. ; Create PID segment
  1. PIDLAB(R) ;EP
  1. N PID,PID3,PID8,PID7
  1. S PID=$G(^APCLDATA($J,R,"PID"))
  1. S PID3=$P(PID,U)
  1. S PID8=$P(PID,U,2)
  1. S PID7=$P(PID,U,3)
  1. S HLQ=HL1("Q")
  1. D SET(.ARY,"PID",0)
  1. D SET(.ARY,1,1)
  1. D SET(.ARY,PID3,3)
  1. D SET(.ARY,PID8,8)
  1. D SET(.ARY,PID7,7)
  1. S X=$$ADDSEG^HLOAPI(.HLST,.ARY,.ERR)
  1. Q
  1. ;
  1. ZIDLAB(R) ;EP -- create the ZID segment
  1. N ZID,ZID1
  1. S ZID=$G(^APCLDATA($J,R,"ZID"))
  1. S ZID1=$P(ZID,U)
  1. D SET(.ARY,"ZID",0)
  1. D SET(.ARY,1,1)
  1. D SET(.ARY,ZID1,2)
  1. S X=$$ADDSEG^HLOAPI(.HLST,.ARY,.ERR)
  1. Q
  1. ;
  1. PV1LAB(R) ;EP -- setup the PV1 LAB segment
  1. N PV1,PV13,PV132,PV115,PV144,PV145
  1. S PV1=$G(^APCLDATA($J,R,"PV1"))
  1. S PV13=$P(PV1,U,1)
  1. S PV132=$P(PV1,U,2)
  1. S PV115=$P(PV1,U,3)
  1. S PV144=$P(PV1,U,4)
  1. S PV145=$P(PV1,U,5)
  1. D SET(.ARY,"PV1",0)
  1. D SET(.ARY,1,1)
  1. D SET(.ARY,PV13,3,1)
  1. D SET(.ARY,PV132,3,2)
  1. D SET(.ARY,PV115,15)
  1. D SET(.ARY,PV144,44)
  1. D SET(.ARY,PV145,45)
  1. S X=$$ADDSEG^HLOAPI(.HLST,.ARY,.ERR)
  1. Q
  1. ;
  1. DG1LAB(R) ;EP -- set the repeating DG1
  1. N BDA,DG1,DG13
  1. S BDA=0 F S BDA=$O(^APCLDATA($J,R,"DG1",BDA)) Q:'BDA D
  1. . S DG1=$G(^APCLDATA($J,R,"DG1",BDA))
  1. . S DG13=$P(DG1,U)
  1. . S APCLFCNT=APCLFCNT+1
  1. . D SET(.ARY,"FT1",0)
  1. . D SET(.ARY,APCLFCNT,1)
  1. . D SET(.ARY,DG13,19)
  1. . S X=$$ADDSEG^HLOAPI(.HLST,.ARY,.ERR)
  1. Q
  1. ;
  1. PR1LAB(R) ;EP -- set the repeating DG1
  1. N BDA,PR1,PR13
  1. S BDA=0 F S BDA=$O(^APCLDATA($J,R,"PR1",BDA)) Q:'BDA D
  1. . S PR1=$G(^APCLDATA($J,R,"PR1",BDA))
  1. . S PR13=$P(PR1,U)
  1. . S APCLFCNT=APCLFCNT+1
  1. . D SET(.ARY,"FT1",0)
  1. . D SET(.ARY,+$G(APCLFCNT),1)
  1. . D SET(.ARY,PR13,25)
  1. . S X=$$ADDSEG^HLOAPI(.HLST,.ARY,.ERR)
  1. Q
  1. ;
  1. OBXLAB(R) ;EP -- setup the ILI OBX segment
  1. N BDA,OBX,OBX1,OBX2,OBX31,OBX32,OBX5
  1. S BDA=0 F S BDA=$O(^APCLDATA($J,R,"OBX",BDA)) Q:'BDA D
  1. . S OBX=$G(^APCLDATA($J,R,"OBX",BDA))
  1. . S OBX1=$P(OBX,U)
  1. . S OBX2=$P(OBX,U,2)
  1. . S OBX3=$P(OBX,U,3)
  1. . I OBX3'="TMP" D
  1. .. S OBX31=$P(OBX3,"~")
  1. .. S OBX32=$P(OBX3,"~",2)
  1. . S OBX5=$P(OBX,U,4)
  1. . D SET(.ARY,"OBX",0)
  1. . D SET(.ARY,OBX1,1)
  1. . D SET(.ARY,OBX2,2)
  1. . I '$G(OBX31) D SET(.ARY,OBX3,3)
  1. . I $G(OBX31) D
  1. .. I $G(OBX31)]"" D SET(.ARY,OBX31,3,1)
  1. .. D SET(.ARY,OBX32,3,2)
  1. . D SET(.ARY,OBX5,5)
  1. . S X=$$ADDSEG^HLOAPI(.HLST,.ARY,.ERR)
  1. Q
  1. ;
  1. SET(ARY,V,F,C,S,R) ;EP
  1. D SET^HLOAPI(.ARY,.V,.F,.C,.S,.R)
  1. Q
  1. ;