VAFCA04 ;ALB/RJS-Creates the Registration Message ; 26 Mar 2003 3:13 PM
;;5.3;Registration;**91,209,149,261,298,415,484,508**;Aug 13, 1993
;
;07/07/00 ACS - Added sequence 21 (physical treating specialty - ward
;location) and sequence 39 (facility+suffix) to the inpatient string
;of fields. Added sequence 39 to the outpatient string of fields.
;
EN(DFN,VAFCDATE,USER,PIVOTPTR) ;
Q:($G(DFN)="")!($G(VAFCDATE)="") "-1^Missing required parameter(s)"
N ERR,VCCI,SITE,FS,VAFCDT,VAFHPIV,REP,DGREL,DGINC,DGINR,DGDEP,VAFSTR
N ICN,CHKSUM,SETICN,SETLOC,HLA,HLRST,PV1,LIN
;
;check HL7 V2.3 messaging flag
N SEND S SEND=$P($$SEND^VAFHUTL(),"^",2)
Q:SEND=0 "-1^Stop HL7 V2.3 messaging flag is set"
;
S USER=+$G(USER)
I 'USER,$D(DUZ) S USER=DUZ
I 'USER,'$D(DUZ) S USER=0
S PIVOTPTR=+$G(PIVOTPTR)
I 'PIVOTPTR D
.S VAFHPIV=+$$PIVNW^VAFHPIVT(DFN,VAFCDATE,3,DFN_";DPT(")
.Q:+VAFHPIV<0
.S PIVOTPTR=+$O(^VAT(391.71,"D",VAFHPIV,0))
;
Q:+$G(VAFHPIV)<0 "-1^Could Not Create ADT/HL7 Pivot file entry"
K ERR
;log edited field(s) in the ADT/HL7
I $D(VAFCFLDS) D
. S VAFCFLDS=$$PROCESS^VAFCDD01()
. Q:VAFCFLDS'=-1
. D REGEDIT^VAFCDD01(PIVOTPTR,VAFCFLDS)
;Messaging flag set to SUSPEND - flag entry in ADT/HL7 Pivot file
; for transmission and quit
I SEND=2 D TRANSMIT^VAFCDD01(PIVOTPTR) Q 1
K VAFCFLDS
D INIT^HLFNC2("VAFC ADT-A04 SERVER",.HL)
Q:$G(HL)]"" "-1^VAFC A04 SERVER NOT DEFINED PROPERLY"
S FS=HL("FS"),REP=$E(HL("ECH"))
;
S VAFCDT=$$HLDATE^HLFNC(VAFCDATE,"TS")
S HLA("HLS",1)="EVN"_HLFS_"A04"_HLFS_VAFCDT_HLFS_HLFS_HLFS_USER_REP
S DIC="^VA(200,",DIC(0)="MZO",X="`"_USER D ^DIC K DIC
N DGNAME S DGNAME("FILE")=200,DGNAME("IENS")=USER,DGNAME("FIELD")=.01
I USER'=0 S HLA("HLS",1)=HLA("HLS",1)_$$HLNAME^XLFNAME(.DGNAME,"",$E($G(HLECH)))
; ^ possible to not have a user defined
S LIN=1
K Y S VAFSTR=$$COMMANUM^VAFCADT2(1,9)_",10B,11PC,"_$$COMMANUM^VAFCADT2(13,21)_",22B,"_$$COMMANUM^VAFCADT2(23,30)
S HLA("HLS",$$ADD(.LIN,1))=$$EN^VAFCPID(DFN,VAFSTR)
;CHECK IF PATIENT HAS AN ICN
I $P(HLA("HLS",LIN),HLFS,3)=HLQ D
. N X S X="MPIF001" X ^%ZOSF("TEST") Q:'$T
. ; if patient does not have an ICN still pass HLQ
. S ICN=$$GETICN^MPIF001(DFN)
. I +ICN>0 S $P(HLA("HLS",LIN),HLFS,3)=ICN
MERGE HLA("HLS",LIN)=VAFPID K VAFPID
S VAFSTR=$$COMMANUM^VAFCADT2(1,12)
S HLA("HLS",$$ADD(.LIN,1))=$$EN^VAFHLPD1(DFN,VAFSTR)
S VAFHPIV=$P($G(^VAT(391.71,PIVOTPTR,0)),"^",2)
Q:VAFHPIV'>0 "-1^COULDN'T FIND PIVOT ENTRY"
I $G(^DPT(DFN,.1))]"" D
. S PV1=$$EN^VAFHAPV1(DFN,VAFCDATE,",2,3,7,8,10,18,21,39,44,45,50")
. S HLA("HLS",$$ADD(.LIN,1))=PV1
. S VAFSTR=$$COMMANUM^VAFCADT2(1,4)
. N HLAROL
. D BLDROL^VAFCROL("HLAROL",DFN,VAFCDATE,VAFSTR,VAFHPIV)
. N I,J,K
. S I=""
. F K=1:1 S I=+$O(HLAROL(I)) Q:('I) D
. . S J=""
. . F S J=$O(HLAROL(I,J)) Q:(J="") D
. . . S:('J) HLA("HLS",LIN+K)=HLAROL(I,J)
. . . S:(J) HLA("HLS",LIN+K,J)=HLAROL(I,J)
. S LIN=LIN+K-1
E D
. S PV1=$$OPV1^VAFHCPV(DFN,+VAFHPIV,VAFCDATE,DFN_";DPT(",",2,3,7,18,39,45,50",1)
. S HLA("HLS",$$ADD(.LIN,1))=PV1
S HLA("HLS",$$ADD(.LIN,1))=$$EN^VAFHLOBX(DFN)
S VAFSTR=$$COMMANUM^VAFCADT2(1,21)
S HLA("HLS",$$ADD(.LIN,1))=$$EN^VAFHLZPD(DFN,VAFSTR)
S VAFSTR=$$COMMANUM^VAFCADT2(1,5)
S HLA("HLS",$$ADD(.LIN,1))=$$EN^VAFHLZSP(DFN)
S VAFSTR=$$COMMANUM^VAFCADT2(1,22)
S HLA("HLS",$$ADD(.LIN,1))=$$EN^VAFHLZEL(DFN,VAFSTR)
S HLA("HLS",$$ADD(.LIN,1))=$$EN^VAFHLZCT(DFN,"1,2,3,4,5,6,7,8,9")
S HLA("HLS",$$ADD(.LIN,1))=$$EN^VAFHLZEM(DFN,"1,2,3,4,5,6,7,8")
S HLA("HLS",$$ADD(.LIN,1))="ZFF"_HL("FS")_2_HL("FS")_$P($G(^VAT(391.71,+$G(PIVOTPTR),2)),U)
D ALL^DGMTU21(DFN,"V",VAFCDATE,"R")
S VAFSTR=$$COMMANUM^VAFCADT2(1,13)
S HLA("HLS",$$ADD(.LIN,1))=$$EN^VAFHLZIR(+$G(DGINR("V")),VAFSTR,1)
S VAFSTR=$$COMMANUM^VAFCADT2(1,10)
S HLA("HLS",$$ADD(.LIN,1))=$$EN^VAFHLZEN(DFN,VAFSTR,1,HL("Q"),HL("FS"))
D GENERATE^HLMA("VAFC ADT-A04 SERVER","LM",1,.HLRST,"",.HL)
;Store result in pivot file
S HLRST=$S(+HLRST:HLRST,1:$P(HLRST,U,3))
I +HLRST>0 D MESSAGE^VAFCDD01(PIVOTPTR,+HLRST)
D FILERM^VAFCUTL($O(^VAT(391.71,"D",+VAFHPIV,0)),HLRST)
;
EX ;
Q 1
;
ADD(LINE,COUNTER) ;Increments Line = Line + Counter
;Input : LINE - Line number
; COUNTER - Increment number
;Output : Updated LINE value
;
S LINE=$G(LINE),COUNTER=$G(COUNTER)
S LINE=LINE+COUNTER
Q LINE
;
HL7A04(PIVOTNUM,IEN) ;
;A new Registration was created capture the key demographic data.
;Create an HL7 V2.3 entry in the ADT/HL PIVOT file so that the
;demographic data can be broadcasted.
; VAFCFLDS is set in routine VAFCDD01. It contains the
; fields that were edited.
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAFCA04 4677 printed Apr 09, 2024@21:45:14 Page 2
VAFCA04 ;ALB/RJS-Creates the Registration Message ; 26 Mar 2003 3:13 PM
+1 ;;5.3;Registration;**91,209,149,261,298,415,484,508**;Aug 13, 1993
+2 ;
+3 ;07/07/00 ACS - Added sequence 21 (physical treating specialty - ward
+4 ;location) and sequence 39 (facility+suffix) to the inpatient string
+5 ;of fields. Added sequence 39 to the outpatient string of fields.
+6 ;
EN(DFN,VAFCDATE,USER,PIVOTPTR) ;
+1 if ($GET(DFN)="")!($GET(VAFCDATE)="")
QUIT "-1^Missing required parameter(s)"
+2 NEW ERR,VCCI,SITE,FS,VAFCDT,VAFHPIV,REP,DGREL,DGINC,DGINR,DGDEP,VAFSTR
+3 NEW ICN,CHKSUM,SETICN,SETLOC,HLA,HLRST,PV1,LIN
+4 ;
+5 ;check HL7 V2.3 messaging flag
+6 NEW SEND
SET SEND=$PIECE($$SEND^VAFHUTL(),"^",2)
+7 if SEND=0
QUIT "-1^Stop HL7 V2.3 messaging flag is set"
+8 ;
+9 SET USER=+$GET(USER)
+10 IF 'USER
IF $DATA(DUZ)
SET USER=DUZ
+11 IF 'USER
IF '$DATA(DUZ)
SET USER=0
+12 SET PIVOTPTR=+$GET(PIVOTPTR)
+13 IF 'PIVOTPTR
Begin DoDot:1
+14 SET VAFHPIV=+$$PIVNW^VAFHPIVT(DFN,VAFCDATE,3,DFN_";DPT(")
+15 if +VAFHPIV<0
QUIT
+16 SET PIVOTPTR=+$ORDER(^VAT(391.71,"D",VAFHPIV,0))
End DoDot:1
+17 ;
+18 if +$GET(VAFHPIV)<0
QUIT "-1^Could Not Create ADT/HL7 Pivot file entry"
+19 KILL ERR
+20 ;log edited field(s) in the ADT/HL7
+21 IF $DATA(VAFCFLDS)
Begin DoDot:1
+22 SET VAFCFLDS=$$PROCESS^VAFCDD01()
+23 if VAFCFLDS'=-1
QUIT
+24 DO REGEDIT^VAFCDD01(PIVOTPTR,VAFCFLDS)
End DoDot:1
+25 ;Messaging flag set to SUSPEND - flag entry in ADT/HL7 Pivot file
+26 ; for transmission and quit
+27 IF SEND=2
DO TRANSMIT^VAFCDD01(PIVOTPTR)
QUIT 1
+28 KILL VAFCFLDS
+29 DO INIT^HLFNC2("VAFC ADT-A04 SERVER",.HL)
+30 if $GET(HL)]""
QUIT "-1^VAFC A04 SERVER NOT DEFINED PROPERLY"
+31 SET FS=HL("FS")
SET REP=$EXTRACT(HL("ECH"))
+32 ;
+33 SET VAFCDT=$$HLDATE^HLFNC(VAFCDATE,"TS")
+34 SET HLA("HLS",1)="EVN"_HLFS_"A04"_HLFS_VAFCDT_HLFS_HLFS_HLFS_USER_REP
+35 SET DIC="^VA(200,"
SET DIC(0)="MZO"
SET X="`"_USER
DO ^DIC
KILL DIC
+36 NEW DGNAME
SET DGNAME("FILE")=200
SET DGNAME("IENS")=USER
SET DGNAME("FIELD")=.01
+37 IF USER'=0
SET HLA("HLS",1)=HLA("HLS",1)_$$HLNAME^XLFNAME(.DGNAME,"",$EXTRACT($GET(HLECH)))
+38 ; ^ possible to not have a user defined
+39 SET LIN=1
+40 KILL Y
SET VAFSTR=$$COMMANUM^VAFCADT2(1,9)_",10B,11PC,"_$$COMMANUM^VAFCADT2(13,21)_",22B,"_$$COMMANUM^VAFCADT2(23,30)
+41 SET HLA("HLS",$$ADD(.LIN,1))=$$EN^VAFCPID(DFN,VAFSTR)
+42 ;CHECK IF PATIENT HAS AN ICN
+43 IF $PIECE(HLA("HLS",LIN),HLFS,3)=HLQ
Begin DoDot:1
+44 NEW X
SET X="MPIF001"
XECUTE ^%ZOSF("TEST")
if '$TEST
QUIT
+45 ; if patient does not have an ICN still pass HLQ
+46 SET ICN=$$GETICN^MPIF001(DFN)
+47 IF +ICN>0
SET $PIECE(HLA("HLS",LIN),HLFS,3)=ICN
End DoDot:1
+48 MERGE HLA("HLS",LIN)=VAFPID
KILL VAFPID
+49 SET VAFSTR=$$COMMANUM^VAFCADT2(1,12)
+50 SET HLA("HLS",$$ADD(.LIN,1))=$$EN^VAFHLPD1(DFN,VAFSTR)
+51 SET VAFHPIV=$PIECE($GET(^VAT(391.71,PIVOTPTR,0)),"^",2)
+52 if VAFHPIV'>0
QUIT "-1^COULDN'T FIND PIVOT ENTRY"
+53 IF $GET(^DPT(DFN,.1))]""
Begin DoDot:1
+54 SET PV1=$$EN^VAFHAPV1(DFN,VAFCDATE,",2,3,7,8,10,18,21,39,44,45,50")
+55 SET HLA("HLS",$$ADD(.LIN,1))=PV1
+56 SET VAFSTR=$$COMMANUM^VAFCADT2(1,4)
+57 NEW HLAROL
+58 DO BLDROL^VAFCROL("HLAROL",DFN,VAFCDATE,VAFSTR,VAFHPIV)
+59 NEW I,J,K
+60 SET I=""
+61 FOR K=1:1
SET I=+$ORDER(HLAROL(I))
if ('I)
QUIT
Begin DoDot:2
+62 SET J=""
+63 FOR
SET J=$ORDER(HLAROL(I,J))
if (J="")
QUIT
Begin DoDot:3
+64 if ('J)
SET HLA("HLS",LIN+K)=HLAROL(I,J)
+65 if (J)
SET HLA("HLS",LIN+K,J)=HLAROL(I,J)
End DoDot:3
End DoDot:2
+66 SET LIN=LIN+K-1
End DoDot:1
+67 IF '$TEST
Begin DoDot:1
+68 SET PV1=$$OPV1^VAFHCPV(DFN,+VAFHPIV,VAFCDATE,DFN_";DPT(",",2,3,7,18,39,45,50",1)
+69 SET HLA("HLS",$$ADD(.LIN,1))=PV1
End DoDot:1
+70 SET HLA("HLS",$$ADD(.LIN,1))=$$EN^VAFHLOBX(DFN)
+71 SET VAFSTR=$$COMMANUM^VAFCADT2(1,21)
+72 SET HLA("HLS",$$ADD(.LIN,1))=$$EN^VAFHLZPD(DFN,VAFSTR)
+73 SET VAFSTR=$$COMMANUM^VAFCADT2(1,5)
+74 SET HLA("HLS",$$ADD(.LIN,1))=$$EN^VAFHLZSP(DFN)
+75 SET VAFSTR=$$COMMANUM^VAFCADT2(1,22)
+76 SET HLA("HLS",$$ADD(.LIN,1))=$$EN^VAFHLZEL(DFN,VAFSTR)
+77 SET HLA("HLS",$$ADD(.LIN,1))=$$EN^VAFHLZCT(DFN,"1,2,3,4,5,6,7,8,9")
+78 SET HLA("HLS",$$ADD(.LIN,1))=$$EN^VAFHLZEM(DFN,"1,2,3,4,5,6,7,8")
+79 SET HLA("HLS",$$ADD(.LIN,1))="ZFF"_HL("FS")_2_HL("FS")_$PIECE($GET(^VAT(391.71,+$GET(PIVOTPTR),2)),U)
+80 DO ALL^DGMTU21(DFN,"V",VAFCDATE,"R")
+81 SET VAFSTR=$$COMMANUM^VAFCADT2(1,13)
+82 SET HLA("HLS",$$ADD(.LIN,1))=$$EN^VAFHLZIR(+$GET(DGINR("V")),VAFSTR,1)
+83 SET VAFSTR=$$COMMANUM^VAFCADT2(1,10)
+84 SET HLA("HLS",$$ADD(.LIN,1))=$$EN^VAFHLZEN(DFN,VAFSTR,1,HL("Q"),HL("FS"))
+85 DO GENERATE^HLMA("VAFC ADT-A04 SERVER","LM",1,.HLRST,"",.HL)
+86 ;Store result in pivot file
+87 SET HLRST=$SELECT(+HLRST:HLRST,1:$PIECE(HLRST,U,3))
+88 IF +HLRST>0
DO MESSAGE^VAFCDD01(PIVOTPTR,+HLRST)
+89 DO FILERM^VAFCUTL($ORDER(^VAT(391.71,"D",+VAFHPIV,0)),HLRST)
+90 ;
EX ;
+1 QUIT 1
+2 ;
ADD(LINE,COUNTER) ;Increments Line = Line + Counter
+1 ;Input : LINE - Line number
+2 ; COUNTER - Increment number
+3 ;Output : Updated LINE value
+4 ;
+5 SET LINE=$GET(LINE)
SET COUNTER=$GET(COUNTER)
+6 SET LINE=LINE+COUNTER
+7 QUIT LINE
+8 ;
HL7A04(PIVOTNUM,IEN) ;
+1 ;A new Registration was created capture the key demographic data.
+2 ;Create an HL7 V2.3 entry in the ADT/HL PIVOT file so that the
+3 ;demographic data can be broadcasted.
+4 ; VAFCFLDS is set in routine VAFCDD01. It contains the
+5 ; fields that were edited.
