source: FOIAVistA/trunk/r/SPINAL_CORD_DYSFUNCTION-SPN/SPNHL1.m@ 1635

SPNHL1 ;WDE/SAN-DIEGO;Build the hl7 segment for file 154
 ;;2.0;Spinal Cord Dysfunction;**10,12,15,24**;01/02/97
 ;this routine is called from spnhl7 spnhl7 is called from the
 ;edit rtn for file 154
EN(SPNFDFN) ;
 K OBXCNT,SPNOBR,SPLINE,DATA,X,Y,SPNDD,SPNDT,SPNTMP
 ;collect the registration data from 154
 S SPNOBR=1,OBXCNT=1
 S OBXCNT=1
 S SPLINE="",SPLINE=$O(SPMSG(SPLINE),-1)+1
 S SPMSG(SPLINE)="OBR|"_SPNOBR_"|||Registration OBR"
 ;set up the obr with the date of registration
 S X=$$GET1^DIQ(154,SPNFDFN_",",.02,"I"),X=$$HLDATE^HLFNC(X,"TS")
 S $P(SPMSG(SPLINE),"|",8)=X S SPLINE=SPLINE+1
 S SPNDD=$G(^DD(154,.02,0)),SPNDD=$P(SPNDD,U,1)
 ;loop through the fields and set up the message
 ;this section will set up all data type of date (ts)
 F X=.02,.05,8.8,10.2 D
 . S SPNDD=$G(^DD(154,X,0)),SPNDD=$P(SPNDD,U,1) S:SPNDD="" SPNDD="ERROR"
 . S SPDATA=$$GET1^DIQ(154,SPNFDFN_",",X,"I") I $G(SPDATA)'="" D
 .. S SPDATA=$$HLDATE^HLFNC(SPDATA,"TS")
 .. S SPMSG(SPLINE)="OBX|"_OBXCNT_"|TS|"_X_"^"_SPNDD_"||"_SPDATA
 .. S SPLINE=SPLINE+1,OBXCNT=OBXCNT+1,SPNDD=""
 .. S (SPDATA,SPNDD)=""
 F SPNCOMP=999.06,999.07,999.08 D
 . S X=$$GET1^DIQ(154,SPNFDFN_",",SPNCOMP,"") I $G(X)'="" D
 .. D ^%DT S SPDATA=Y  ;flip date around to fm type
 .. S SPDATA=$$HLDATE^HLFNC(SPDATA,"TS")
 .. S SPNDD=$G(^DD(154,SPNCOMP,0)),SPNDD=$P(SPNDD,U,1) S:SPNDD="" SPNDD="ERROR"
 .. S SPMSG(SPLINE)="OBX|"_OBXCNT_"|TS|"_SPNCOMP_"^"_SPNDD_"||"_SPDATA
 .. S SPLINE=SPLINE+1,OBXCNT=OBXCNT+1,SPNDD=""
 .. S (SPDATA,SPNDD)=""
 ;check for date of death if so get it
 S SPDATA=$$GET1^DIQ(2,SPNFDFN_",",.351,"I") I $G(SPDATA)'="" D
 . S SPDATA=$$HLDATE^HLFNC(SPDATA,"TS")
 . S SPMSG(SPLINE)="OBX|"_OBXCNT_"|TS|"_".351"_"^"_"DATE OF DEATH"_"||"_SPDATA
 . S SPLINE=SPLINE+1,OBXCNT=OBXCNT+1,SPNDD="",SPDATA=""
 ;
 ;this secton will set up all data types of free text (ST)
 F X=.03,2.1,2.2,2.3,2.4,2.5,2.6,3.1,3.2,3.3,3.4,3.5,5.01,5.11,5.12,6.09,8.3,8.4,8.6,10.3,999.03,999.04,999.05 D
 . S SPNDD=$G(^DD(154,X,0)),SPNDD=$P(SPNDD,U,1) S:SPNDD="" SPNDD="ERROR"
 . S SPDATA=$$GET1^DIQ(154,SPNFDFN_",",X) I $G(SPDATA)'="" D
 .. S SPNTBL=$S(X=".03":"^VA0504",X="2.2":"^VA0505",X="2.3":"^VA0506",X="2.6":"^VA0507",1:"")
 .. S SPMSG(SPLINE)="OBX|"_OBXCNT_"|ST|"_X_"^"_SPNDD_SPNTBL_"||"_SPDATA
 .. S SPLINE=SPLINE+1,OBXCNT=OBXCNT+1,SPNDD=""
 .. S (SPDATA,SPNDD,SPNTBL)=""
 ;
 ;set up station suffix from 40.8
 S SPMSG(SPLINE)="OBX|"_OBXCNT_"|ST|154.91.2^DIVISION||"_$$EN^SPNMAIN(DUZ)
 S SPLINE=SPLINE+1,OBXCNT=OBXCNT+1,SPNDD=""
 ;this section is as well data types of free text (ST)
 F X=1.1,5.02,5.03,5.04,5.05,5.06,5.07,5.08,5.09,5.1,5.13,5.14,10.1,8.1,8.2 D
 . S SPNDD=$G(^DD(154,X,0)),SPNDD=$P(SPNDD,U,1) S:SPNDD="" SPNDD="ERROR"
 . S SPDATA=$$GET1^DIQ(154,SPNFDFN_",",X) I $G(SPDATA)'="" D
 .. S SPMSG(SPLINE)="OBX|"_OBXCNT_"|ST|"_X_"^"_SPNDD_"||"_SPDATA
 .. S SPLINE=SPLINE+1,OBXCNT=OBXCNT+1,SPNDD=""
 .. S (SPDATA,SPNDD)=""
 ;this section will collect the etiology information
 D GETS^DIQ(154,SPNFDFN_",","4*","","SPNTMP")
 S SPNET="" F  S SPNET=$O(SPNTMP(154.004,SPNET)) Q:(SPNET="")!('+SPNET)  D ETIOBR S SPND="" F  S SPND=$O(SPNTMP(154.004,SPNET,SPND)) Q:(SPND="")!('+SPND)  D
 . S SPNDD=$G(^DD(154.004,SPND,0)),SPNDD=$P(SPNDD,U,1) S:SPNDD="" SPNDD="ERROR"
 . S X=$G(SPNTMP(154.004,SPNET,SPND)) I $G(X)'="" D
 .. I SPND=".02" D ^%DT S X=$$HLDATE^HLFNC(Y,"TS")  ;make hl7 date
 .. S SPNTBL=$S(SPND=.01:"^VA503",1:"")
 .. S SPDTYPE=$S(SPND=.02:"TS",1:"ST")
 .. S SPMSG(SPLINE)="OBX|"_OBXCNT_"|"_SPDTYPE_"|"_SPND_"^"_SPNDD_SPNTBL_"||"_X S SPLINE=SPLINE+1,OBXCNT=OBXCNT+1
 .. K SPDTYPE,SPNTBL
 .Q
EVAL ;
 K SPNTMP,SPDATA,SPDD,SPD
 D GETS^DIQ(154,SPNFDFN_",","7*","I","SPNTMP")
 S SPNET="" F  S SPNET=$O(SPNTMP(154.07,SPNET)) Q:(SPNET="")!('+SPNET)  D EVLOBR S SPND=0 F  S SPND=$O(SPNTMP(154.07,SPNET,SPND)) Q:(SPND="")!('+SPND)  D
 . S SPDATA=$G(SPNTMP(154.07,SPNET,SPND,"I")) I $G(SPDATA)'="" D
 .. S SPDATA=$$HLDATE^HLFNC(SPDATA,"TS")
 .. S SPNDD=$G(^DD(154.07,SPND,0)),SPNDD=$P(SPNDD,U,1) S:SPNDD="" SPNDD="-----"
 .. S SPMSG(SPLINE)="OBX|"_OBXCNT_"|TS|"_SPND_"^"_SPNDD_"||"_SPDATA
 .. S SPLINE=SPLINE+1,OBXCNT=OBXCNT+1
 .. S (SPDATA,SPNDD,SPD)=""
 K SPNTMP
 Q
 ;
ETIOBR ;
 S SPNOBR=SPNOBR+1
 S X=$G(SPNTMP(154.004,SPNET,.02)) D ^%DT S ETDATE=Y K Y,X
 S ETDATE=$$HLDATE^HLFNC(ETDATE,"TS")
 ;note that this resets the date to an hl7 format
 S SPMSG(SPLINE)="OBR|"_SPNOBR_"|||154 ETIOLOGY DATA|||"_ETDATE
 S SPLINE=SPLINE+1
 S OBXCNT=1
 Q
EVLOBR ;
 S SPNOBR=SPNOBR+1
 S SPDT=$G(SPNTMP(154.07,SPNET,.01,"I"))
 S SPDT=$$HLDATE^HLFNC(SPDT,"TS")
 S SPMSG(SPLINE)="OBR|"_SPNOBR_"|||154 ANNUAL EVAL DATA|||"_SPDT
 S SPLINE=SPLINE+1
 S OBXCNT=1
 Q