SCDXMSG1 ;ALB/JRP - AMB CARE MESSAGE BUILDER UTILS;08-MAY-1996 ; 6/21/05 2:08pm
 ;;5.3;Scheduling;**44,55,70,77,85,66,143,142,162,172,180,239,245,254,293,325,387,459,472**;AUG 13, 1993
 ;
 ;-- Line tags for building HL7 segment
BLDEVN S VAFEVN=$$EN^VAFHLEVN(EVNTHL7,ENCNDT,VAFSTR,HL("Q"),HL("FS"))
 ;SD*5.3*387 replaced EVNTDATE with ENCNDT
 Q
BLDPID S VAFPID=$$EN^VAFHLPID(DFN,VAFSTR)
 D SETMAR^SCMSVUT0(.VAFPID,HL("Q"),HL("FS"))
 Q
BLDZPD S VAFZPD=$$EN1^VAFHLZPD(DFN,VAFSTR)
 D SETPOW^SCMSVUT0(DFN,.VAFZPD,HL("Q"),HL("FS"))
 Q
BLDPV1 D SETID^SCMSVUT0(ENCPTR,DELPTR)
 S VAFPV1=$$EN^VAFHLPV1(ENCPTR,DELPTR,VAFSTR,1,HL("Q"),HL("FS"))
 Q
BLDDG1 K @VAFARRY
 D EN^VAFHLDG1(ENCPTR,VAFSTR,HL("Q"),HL("FS"),VAFARRY)
 Q
BLDPR1 K @VAFARRY
 D SETPRTY^SCMSVUT0(ENCPTR)
 D EN^VAFHLPR1(ENCPTR,VAFSTR,HL("Q"),HL("FS"),HL("ECH"),VAFARRY)
 Q
BLDZEL N ELCOD,ELIGENC,I,VAFMSTDT
 S VAFMSTDT=ENCDT
 D EN1^VAFHLZEL(DFN,VAFSTR,1,.VAFZEL)
 S ELCOD=$P($G(^SCE(ENCPTR,0)),"^",13),ELIGENC=$P($G(^DIC(8,+ELCOD,0)),"^",9)
 S $P(VAFZEL(1),HL("FS"),3)=ELIGENC
 Q
BLDZIR K DGREL,DGINC,DGINR,DGDEP
 D ALL^DGMTU21(DFN,"V",ENCDT,"R")
 S VAFZIR=$$EN^VAFHLZIR(+$G(DGINR("V")),VAFSTR,1,ENCPTR)
 K DGREL,DGINC,DGINR,DGDEP
 Q
BLDZCL K @VAFARRY
 D EN^VAFHLZCL(DFN,ENCPTR,VAFSTR,HL("Q"),HL("FS"),VAFARRY)
 Q
BLDZSC K @VAFARRY
 D EN^VAFHLZSC(ENCPTR,VAFSTR,HL("Q"),HL("FS"),VAFARRY)
 Q
BLDZSP S VAFZSP=$$EN^VAFHLZSP(DFN,1,1)
 S VAFZSP=$$SETVSI^SCMSVUT0(DFN,$G(VAFZSP),HL("Q"),HL("FS"))
 Q
BLDROL K @VAFARRY
 N SCDXPRV,SCDXPAR,SCDXROL,PTRPRV,NODE,PRVNUM,TMP
 D GETPRV^SDOE(ENCPTR,"SCDXPRV")
 S PTRPRV=0
 F PRVNUM=1:1  S PTRPRV=+$O(SCDXPRV(PTRPRV)) Q:('PTRPRV)  D
 .K SCDXPAR,SCDXROL
 .S NODE=SCDXPRV(PTRPRV)
 .S SCDXPAR("PTR200")=+NODE
 .S SCDXPAR("INSTID")=$$VID4XMIT^SCDXFU11(XMITPTR)_"-"_(+NODE)_"*"_PRVNUM
 .S SCDXPAR("ACTION")="CO"
 .S SCDXPAR("ALTROLE")=($TR($P(NODE,"^",4),"PS","10"))_$E(HL("ECH"),1)_HL("Q")_$E(HL("ECH"),1)_"VA01"
 .S SCDXPAR("CODEONLY")=0
 .S SCDXPAR("RDATE")=ENCDT
 .D OUTPAT^VAFHLROL("SCDXPAR","SCDXROL",VAFSTR,HL("FS"),HL("ECH"),HL("Q"),240)
 .K SCDXROL("ERROR"),SCDXROL("WARNING")
 .M @VAFARRY@(PRVNUM)=SCDXROL
 Q
BLDPD1 S VAFPD1=$$EN^VAFHLPD1(DFN,VAFSTR)
 Q
BLDZEN S VAFZEN=$$EN^VAFHLZEN(DFN,VAFSTR,1,HL("Q"),HL("FS"))
 Q
 ;
 ;-- Line tags for validating HL7 segments
VLDEVN S ERROR=$$EN^SCMSVEVN(VAFEVN,HL("Q"),HL("FS"),VALERR)
 S:(ERROR>0) ERROR=0
 Q
VLDPID S ERROR=$$EN^SCMSVPID(.VAFPID,HL("Q"),HL("FS"),HL("ECH"),VALERR,ENCDT,EVNTHL7)
 S:(ERROR>0) ERROR=0
 Q
VLDZPD S ERROR=$$EN^SCMSVZPD(.VAFZPD,HL("Q"),HL("FS"),VALERR,ENCDT,NODE)
 S:(ERROR>0) ERROR=0
 Q
VLDPV1 S ERROR=$$EN^SCMSVPV1(VAFPV1,HL("Q"),HL("FS"),VALERR,NODE,EVNTHL7,ENCNDT)
 S:(ERROR>0) ERROR=0
 Q
VLDDG1 S ERROR=$$EN^SCMSVDG1(VAFARRY,HL("Q"),HL("FS"),ENCPTR,VALERR,ENCDT)
 S:(ERROR>0) ERROR=0
 Q
VLDPR1 S ERROR=$$EN^SCMSVPR1(VAFARRY,HL("Q"),HL("FS"),HL("ECH"),VALERR,ENCDT)
 S:(ERROR>0) ERROR=0
 Q
VLDZEL S ERROR=$$EN^SCMSVZEL(.VAFZEL,HL("Q"),HL("FS"),VALERR,DFN)
 S:(ERROR>0) ERROR=0
 Q
VLDZIR S ERROR=$$EN^SCMSVZIR(VAFZIR,HL("Q"),HL("FS"),VALERR)
 S:(ERROR>0) ERROR=0
 Q
VLDZCL S ERROR=$$EN^SCMSVZCL(VAFARRY,HL("Q"),HL("FS"),VALERR,DFN)
 S:(ERROR>0) ERROR=0
 Q
VLDZSC S ERROR=$$EN^SCMSVZSC(VAFARRY,HL("Q"),HL("FS"),VALERR,ENCPTR)
 S:(ERROR>0) ERROR=0
 Q
VLDZSP S ERROR=$$EN^SCMSVZSP(VAFZSP,HL("Q"),HL("FS"),VALERR,DFN)
 S:(ERROR>0) ERROR=0
 Q
VLDROL S ERROR=$$EN^SCMSVROL(VAFARRY,HL("Q"),HL("FS"),HL("ECH"),VALERR)
 S:(ERROR>0) ERROR=0
 Q
VLDPD1 S ERROR=0
 Q
VLDZEN S ERROR=0
 Q
 ;
 ;-- Line tags for copying HL7 segments into HL7 message
CPYEVN N I
 S @XMITARRY@(CURLINE)=VAFEVN
 S LINESADD=LINESADD+1
 S I=""
 F  S I=+$O(VAFEVN(I)) Q:('I)  D
 .S @XMITARRY@(CURLINE,I)=VAFEVN(I)
 .S LINESADD=LINESADD+1
 Q
CPYPID N I
 S @XMITARRY@(CURLINE)=VAFPID
 S LINESADD=LINESADD+1
 S I=""
 F  S I=+$O(VAFPID(I)) Q:('I)  D
 .S @XMITARRY@(CURLINE,I)=VAFPID(I)
 .S LINESADD=LINESADD+1
 Q
CPYZPD N I
 S @XMITARRY@(CURLINE)=VAFZPD
 S LINESADD=LINESADD+1
 S I=""
 F  S I=+$O(VAFZPD(I)) Q:('I)  D
 .S @XMITARRY@(CURLINE,I)=VAFZPD(I)
 .S LINESADD=LINESADD+1
 Q
CPYPV1 N I
 S @XMITARRY@(CURLINE)=VAFPV1
 S LINESADD=LINESADD+1
 S I=""
 F  S I=+$O(VAFPV1(I)) Q:('I)  D
 .S @XMITARRY@(CURLINE,I)=VAFPV1(I)
 .S LINESADD=LINESADD+1
 Q
CPYDG1 N I,J,K
 S I=""
 F K=0:1 S I=+$O(@VAFARRY@(I)) Q:('I)  D
 .S J=""
 .F  S J=$O(@VAFARRY@(I,J)) Q:(J="")  D
 ..S:('J) @XMITARRY@(CURLINE+K)=@VAFARRY@(I,J)
 ..S:(J) @XMITARRY@(CURLINE+K,J)=@VAFARRY@(I,J)
 ..S LINESADD=LINESADD+1
 S CURLINE=CURLINE+K-1
 Q
CPYPR1 N I,J,K
 S I=""
 F K=0:1 S I=+$O(@VAFARRY@(I)) Q:('I)  D
 .S J=""
 .F  S J=$O(@VAFARRY@(I,J)) Q:(J="")  D
 ..S:('J) @XMITARRY@(CURLINE+K)=@VAFARRY@(I,J)
 ..S:(J) @XMITARRY@(CURLINE+K,J)=@VAFARRY@(I,J)
 ..S LINESADD=LINESADD+1
 S CURLINE=CURLINE+K-1
 Q
CPYZEL N I
 S @XMITARRY@(CURLINE)=VAFZEL(1)
 S LINESADD=LINESADD+1
 S I=""
 F  S I=+$O(VAFZEL(1,I)) Q:('I)  D
 .S @XMITARRY@(CURLINE,I)=VAFZEL(1,I)
 .S LINESADD=LINESADD+1
 Q
CPYZIR N I
 S @XMITARRY@(CURLINE)=VAFZIR
 S LINESADD=LINESADD+1
 N I
 S I=""
 F  S I=+$O(VAFZIR(I)) Q:('I)  D
 .S @XMITARRY@(CURLINE,I)=VAFZIR(I)
 .S LINESADD=LINESADD+1
 Q
CPYZCL N I,J,K
 S I=""
 F K=0:1 S I=+$O(@VAFARRY@(I)) Q:('I)  D
 .S J=""
 .F  S J=$O(@VAFARRY@(I,J)) Q:(J="")  D
 ..S:('J) @XMITARRY@(CURLINE+K)=@VAFARRY@(I,J)
 ..S:(J) @XMITARRY@(CURLINE+K,J)=@VAFARRY@(I,J)
 ..S LINESADD=LINESADD+1
 S CURLINE=CURLINE+K-1
 Q
CPYZSC N I,J,K
 S I=""
 F K=0:1 S I=+$O(@VAFARRY@(I)) Q:('I)  D
 .S J=""
 .F  S J=$O(@VAFARRY@(I,J)) Q:(J="")  D
 ..S:('J) @XMITARRY@(CURLINE+K)=@VAFARRY@(I,J)
 ..S:(J) @XMITARRY@(CURLINE+K,J)=@VAFARRY@(I,J)
 ..S LINESADD=LINESADD+1
 S CURLINE=CURLINE+K-1
 Q
CPYZSP N I
 S @XMITARRY@(CURLINE)=VAFZSP
 S LINESADD=LINESADD+1
 S I=""
 F  S I=+$O(VAFZSP(I)) Q:('I)  D
 .S @XMITARRY@(CURLINE,I)=VAFZSP(I)
 .S LINESADD=LINESADD+1
 Q
CPYROL N I,J,K
 S I=""
 F K=0:1 S I=+$O(@VAFARRY@(I)) Q:('I)  D
 .S J=""
 .F  S J=$O(@VAFARRY@(I,J)) Q:(J="")  D
 ..S:('J) @XMITARRY@(CURLINE+K)=@VAFARRY@(I,J)
 ..S:(J) @XMITARRY@(CURLINE+K,J)=@VAFARRY@(I,J)
 ..S LINESADD=LINESADD+1
 S CURLINE=CURLINE+K-1
 Q
CPYPD1 N I
 S @XMITARRY@(CURLINE)=VAFPD1
 S LINESADD=LINESADD+1
 S I=""
 F  S I=+$O(VAFPD1(I)) Q:('I)  D
 .S @XMITARRY@(CURLINE,I)=VAFPD1(I)
 .S LINESADD=LINESADD+1
 Q
CPYZEN N I
 S @XMITARRY@(CURLINE)=VAFZEN
 S LINESADD=LINESADD+1
 S I=""
 F  S I=+$O(VAFZEN(I)) Q:('I)  D
 .S @XMITARRY@(CURLINE,I)=VAFZEN(I)
 .S LINESADD=LINESADD+1
 Q
 ;
 ;-- Line tags for deleting HL7 segments
DELEVN K VAFEVN
 Q
DELPID K VAFPID
 Q
DELZPD K VAFZPD
 Q
DELPV1 K VAFPV1
 Q
DELDG1 K @VAFARRY
 Q
DELPR1 K @VAFARRY
 Q
DELZEL K VAFZEL
 Q
DELZIR K VAFZIR
 Q
DELZCL K @VAFARRY
 Q
DELZSC K @VAFARRY
 Q
DELZSP K VAFZSP
 Q
DELROL K @VAFARRY
 Q
DELPD1 K VAFPD1
 Q
DELZEN K VAFZEN
 Q
 ;
 ;
SEGMENTS(EVNTTYPE,SEGARRY) ;Build list of HL7 segments for a given
 ; event type
 ;
 ;Input  : EVNTTYPE - Event type to build list for
 ;                    A08 & A23 are the only types currently supported
 ;                    (Defaults to A08)
 ;         SEGARRY - Array to place output in (full global reference)
 ;                   (Defaults to ^TMP("SCDX SEGMENTS",$J))
 ;Output : None
 ;           SEGARRY(Seq,Name) = Fields
 ;             Seq - Sequencing number to order the segments as
 ;                   they should be placed in the HL7 message
 ;             Name - Name of HL7 segment
 ;             Fields - List of fields used by Ambulatory Care
 ;                      VAFSTR would be set to this value
 ;       : MSH segment is not included
 ;
 ;Check input
 S EVNTTYPE=$G(EVNTTYPE)
 S:(EVNTTYPE'="A23") EVNTTYPE="A08"
 S SEGARRY=$G(SEGARRY)
 S:(SEGARRY="") SEGARRY="^TMP(""SCDX SEGMENTS"","_$J_")"
 ;Segments used by A08 & A23
 S @SEGARRY@(1,"EVN")="1,2"
 S @SEGARRY@(2,"PID")="1,2,3,4,5,6,7,8,10N,11PC,13,14,16,17,19,22N"
 S @SEGARRY@(3,"PD1")="3,4"
 S @SEGARRY@(4,"PV1")="1,2,4,14,19,39,44,50"
 ;Building list for A23 - add ZPD segment and quit
 I (EVNTTYPE="A23") D  Q
 .S @SEGARRY@(5,"ZPD")="1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,40"
 S @SEGARRY@(5,"DG1")="1,2,3,4,5,15"
 S @SEGARRY@(6,"PR1")="1,3,16"
 S @SEGARRY@(7,"ROL")="1,2,3,4"
 S @SEGARRY@(8,"ZPD")="1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,40"
 S @SEGARRY@(9,"ZEL")="1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,29,37,38"
 S @SEGARRY@(10,"ZIR")="1,2,3,4,5,6,7,8,9,10,11,12,13"
 S @SEGARRY@(11,"ZCL")="1,2,3"
 S @SEGARRY@(12,"ZSC")="1,2,3"
 S @SEGARRY@(13,"ZSP")="1,2,3,4"
 S @SEGARRY@(14,"ZEN")="1,2,3,4,5,6,7,8,9,10"
 Q
 ;
UNWIND(XMITARRY,INSRTPNT) ;Remove all data that was put into HL7 message
 ;
 ;Input  : XMITARRY - Array containing HL7 message (full global ref)
 ;                    (Defaults to ^TMP("HLS",$J))
 ;         INSRTPNT - Where to begin deletion from (Defaults to 1)
 ;Output : None
 ;
 ;Check input
 S XMITARRY=$G(XMITARRY)
 S:(XMITARRY="") XMITARRY="^TMP(""HLS"","_$J_")"
 S INSRTPNT=$G(INSRTPNT)
 S:(INSRTPNT="") INSRTPNT=1
 ;Remove insertion point from array
 K @XMITARRY@(INSRTPNT)
 ;Remove everything from insertion point to end of array
 F  S INSRTPNT=$O(@XMITARRY@(INSRTPNT)) Q:(INSRTPNT="")  K @XMITARRY@(INSRTPNT)
 ;Done
 Q