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

SCDXMSG1.m

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