- VAFCTFMF ;ALB/JLU,LTL-Broadcast Master File Update for Treating Facility ;09/03/98
- ;;5.3;Registration;**149,261,255,307,361,428,697**;Aug 13, 1993
- ;
- ;Reference to ^ORD(101 supported by IA #872
- BCKTFMFU ;
- ;This entry point is used to generate a Master File update
- ;for each patient that is in the "AXMIT" cross reference in the PIVOT
- ;file.
- ;INPUTS NONE
- ;OUTPUTS Sending of MFU messages
- ;
- ;IA: 2056 - $$GET1^DIQ
- ;IA: 10106 - $$HLDATE^HLFNC
- ;IA: 2161 - INIT^HLFNC2
- ;IA: 2164 - GENERATE^HLMA
- ;IA: 2270 - GET^HLSUB
- ;IA: 2701 - $$GETICN/$$HL7CMOR/$$IFVCCI^MPIF001
- ;IA: 2702 - $$MPINODE^MPIFAPI
- ;IA: 3073 - EN1^RGADT2
- ;IA: 2796 - EXC/STOP^RGHLLOG
- ;IA: 10141 - $$PATCH^XPDUTL
- ;IA: 2171 - $$WHAT^XUAF4
- ;
- ;quit if CIRN is not installed
- N X S X="MPIF001" X ^%ZOSF("TEST") Q:'$T
- N PDFN,LP,EVTDATE,EVTR,SUBSCN,VAFCMPI
- I '$D(^VAT(391.71,"AXMIT",5)) G BCKQ
- F LP=0:0 S LP=$O(^VAT(391.71,"AXMIT",5,LP)) Q:'LP D
- .S PDFN=$P($G(^VAT(391.71,LP,0)),U,3)
- .I PDFN="" D EXC^RGHLLOG(212,"Unable to send TF update due to unknown patient for IEN#"_$G(LP)) D STOP^RGHLLOG(1) Q ; log exception
- .I PDFN'=""&'$D(^DPT(PDFN,0)) D EXC^RGHLLOG(212,"Unable to send TF update due to unknown patient for IEN#"_$G(LP)) D STOP^RGHLLOG(1) Q ; log exception
- .;making sure that your site is added or updated before continuing, FILE will also add CMOR
- . I '$$PATCH^XPDUTL("RG*1.0*4") D FILE^VAFCTFU(PDFN,+$$SITE^VASITE,1)
- .S SUBSCN=$$MPINODE^MPIFAPI(PDFN) I +$G(SUBSCN)<1 D XMITFLAG^VAFCDD01(LP,0,1) Q
- .; if no subscribers (piece 5) and no CMOR (piece 3), turn off xmit flag for Pivot file.
- .I +$P(SUBSCN,"^",3)<1,(+$P(SUBSCN,"^",5)<1) D XMITFLAG^VAFCDD01(LP,0,1)
- .;Removed section to create a new subscription as it is no longer used.
- .;1/23/06
- .I +$P($G(SUBSCN),"^",5)<1 D XMITFLAG^VAFCDD01(LP,0,1) Q
- .K HLL D GET^HLSUB($P(SUBSCN,"^",5),"","VAFC MFU-TFL CLIENT",.HLL) I '$D(HLL("LINKS")) D XMITFLAG^VAFCDD01(LP,0,1) Q
- .K HLL
- .;Update last treatment date and event reason
- .I $$PATCH^XPDUTL("RG*1.0*4") D EN1^RGADT2(PDFN,1)
- .I PDFN DO
- ..K VAFCERR
- ..I $D(^DGCN(391.91,"APAT",PDFN)) D TFMFU(PDFN)
- ..;CALL TAG TO FLIP TRANSMIT FIELD IN VAT(391.71
- ..D:$G(RESLT) XMITFLAG^VAFCDD01(LP,0,1)
- ..;store resulting message in ADT/HL7 PIVOT file
- ..S RESLT=$S($G(RESLT)]"":RESLT,1:$P($G(ER),U,2))
- ..D FILERM^VAFCUTL(LP,RESLT)
- ..K ER,RESLT,VAFCERR Q
- BCKQ Q
- ;
- TFMFU(PDFN) ;
- ;sends a MFU message for a single patient
- N HLEID
- S ER=$$INIT
- I ER G TFMFUQ
- D BLDTFMFU(PDFN)
- ;if error from build don't send
- I '$D(VAFCERR) D SEND
- D KILLHL7
- TFMFUQ Q
- ;
- INIT() ;
- ;initialize HL7 variables
- S ER=0
- S HLEID=+$O(^ORD(101,"B","VAFC MFU-TFL SERVER",0))
- I 'HLEID S ER="1^Unable to initialize HL7 variables - Protocol not found." G INITQ
- S HL=""
- D INIT^HLFNC2(HLEID,.HL)
- I $O(HL(""))="" S ER="1^"_$P(HL,U,2) G INITQ
- I $G(HL)]"" S ER=$G(HL)
- INITQ Q ER
- ;
- ;
- BLDTFMFU(PDFN) ;
- ;builds the segments and formats the HL7 MFU message
- N CTR,INST,ICN,INSTNUM,IEN,TF,EC,INSTNAM,PPF,CMOR
- S PPF=$$IFVCCI^MPIF001(PDFN)
- S EC=$E(HL("ECH"),1,1)
- S CTR=1
- S TFMF(1)="TFL",TFMF(2)="",TFMF(3)=$S(PPF>0:"REP",1:"UPD"),TFMF(4)="",TFMF(5)="",TFMF(6)="NE"
- S CMOR=$$HL7CMOR^MPIF001(PDFN,EC)
- I CMOR'>0 K CMOR
- S HLA("HLS",CTR)=$$EN^VAFHLMFI(HL("ECH"),HL("FS"),HL("Q"),"TFMF")_HL("FS")_$G(CMOR)
- K TFMF
- S ICN=$$GETICN^MPIF001(PDFN)
- S TFMF(1)="MAD",TFMF(2)=""
- I PPF>0 DO
- .F INST=0:0 S INST=$O(^DGCN(391.91,"APAT",PDFN,INST)) Q:'INST S IEN=$O(^(INST,0)),TF=^DGCN(391.91,IEN,0) DO
- ..S INSTNAM=$$WHAT^XUAF4(+$P(TF,U,2),.01)
- ..S INSTNUM=$$WHAT^XUAF4(+$P(TF,U,2),99)
- ..S TFMF(3)=$$HLDATE^HLFNC($P(TF,U,3))
- ..S TFMF(4)=INSTNUM_EC_INSTNAM_EC_"VA"_EC_+ICN_EC_"ICN"_EC_"VA"
- ..D SETMFE
- ..D SETZET(IEN)
- ..Q
- E DO ;NOT THE PRIMARY FACILITY
- .S INSTNAM=$$SITE^VASITE(),INST=+INSTNAM
- .S IEN=$O(^DGCN(391.91,"APAT",PDFN,INST,0))
- .;if there was a subscription but no TF add it, quit and don't send
- .I +IEN'>0 D FILE^VAFCTFU(PDFN,INST,1) S VAFCERR=1 Q
- .S TF=$G(^DGCN(391.91,IEN,0))
- .S TFMF(3)=$$HLDATE^HLFNC($P(TF,"^",3))
- .S TFMF(4)=$P(INSTNAM,U,3)_EC_$P(INSTNAM,U,2)_EC_"VA"_EC_+ICN_EC_"ICN"_EC_"VA"
- .D SETMFE
- .D SETZET(IEN)
- .Q
- BLDTFMFQ K TFMF
- Q
- ;
- SETMFE S CTR=CTR+1
- S HLA("HLS",CTR)=$$EN^VAFHLMFE(HL("ECH"),HL("FS"),HL("Q"),"TFMF")
- Q
- SETZET(IEN) ;Date of Last Treatment event type ZET segment
- S CTR=CTR+1
- S HLA("HLS",CTR)="ZET"_HL("FS")_$$GET1^DIQ(391.91,+IEN_",",.07)
- Q
- ;
- SEND ;
- ;sends the MFU message
- D GENERATE^HLMA(HLEID,"LM",1,.HLRESLT,"","")
- S RESLT=$S(+HLRESLT:HLRESLT,1:$P(HLRESLT,U,3))
- Q
- ;
- KILLHL7 ;
- ;kills off the variables from the HL7 package.
- K HL,HLA,HLECH,HLEID,HLFS,HLMTIEN,HLMTIENA,HLQ,HLRESLT,HLN,HLSAN
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAFCTFMF 4761 printed Feb 19, 2025@00:28:28 Page 2
- VAFCTFMF ;ALB/JLU,LTL-Broadcast Master File Update for Treating Facility ;09/03/98
- +1 ;;5.3;Registration;**149,261,255,307,361,428,697**;Aug 13, 1993
- +2 ;
- +3 ;Reference to ^ORD(101 supported by IA #872
- BCKTFMFU ;
- +1 ;This entry point is used to generate a Master File update
- +2 ;for each patient that is in the "AXMIT" cross reference in the PIVOT
- +3 ;file.
- +4 ;INPUTS NONE
- +5 ;OUTPUTS Sending of MFU messages
- +6 ;
- +7 ;IA: 2056 - $$GET1^DIQ
- +8 ;IA: 10106 - $$HLDATE^HLFNC
- +9 ;IA: 2161 - INIT^HLFNC2
- +10 ;IA: 2164 - GENERATE^HLMA
- +11 ;IA: 2270 - GET^HLSUB
- +12 ;IA: 2701 - $$GETICN/$$HL7CMOR/$$IFVCCI^MPIF001
- +13 ;IA: 2702 - $$MPINODE^MPIFAPI
- +14 ;IA: 3073 - EN1^RGADT2
- +15 ;IA: 2796 - EXC/STOP^RGHLLOG
- +16 ;IA: 10141 - $$PATCH^XPDUTL
- +17 ;IA: 2171 - $$WHAT^XUAF4
- +18 ;
- +19 ;quit if CIRN is not installed
- +20 NEW X
- SET X="MPIF001"
- XECUTE ^%ZOSF("TEST")
- if '$TEST
- QUIT
- +21 NEW PDFN,LP,EVTDATE,EVTR,SUBSCN,VAFCMPI
- +22 IF '$DATA(^VAT(391.71,"AXMIT",5))
- GOTO BCKQ
- +23 FOR LP=0:0
- SET LP=$ORDER(^VAT(391.71,"AXMIT",5,LP))
- if 'LP
- QUIT
- Begin DoDot:1
- +24 SET PDFN=$PIECE($GET(^VAT(391.71,LP,0)),U,3)
- +25 ; log exception
- IF PDFN=""
- DO EXC^RGHLLOG(212,"Unable to send TF update due to unknown patient for IEN#"_$GET(LP))
- DO STOP^RGHLLOG(1)
- QUIT
- +26 ; log exception
- IF PDFN'=""&'$DATA(^DPT(PDFN,0))
- DO EXC^RGHLLOG(212,"Unable to send TF update due to unknown patient for IEN#"_$GET(LP))
- DO STOP^RGHLLOG(1)
- QUIT
- +27 ;making sure that your site is added or updated before continuing, FILE will also add CMOR
- +28 IF '$$PATCH^XPDUTL("RG*1.0*4")
- DO FILE^VAFCTFU(PDFN,+$$SITE^VASITE,1)
- +29 SET SUBSCN=$$MPINODE^MPIFAPI(PDFN)
- IF +$GET(SUBSCN)<1
- DO XMITFLAG^VAFCDD01(LP,0,1)
- QUIT
- +30 ; if no subscribers (piece 5) and no CMOR (piece 3), turn off xmit flag for Pivot file.
- +31 IF +$PIECE(SUBSCN,"^",3)<1
- IF (+$PIECE(SUBSCN,"^",5)<1)
- DO XMITFLAG^VAFCDD01(LP,0,1)
- +32 ;Removed section to create a new subscription as it is no longer used.
- +33 ;1/23/06
- +34 IF +$PIECE($GET(SUBSCN),"^",5)<1
- DO XMITFLAG^VAFCDD01(LP,0,1)
- QUIT
- +35 KILL HLL
- DO GET^HLSUB($PIECE(SUBSCN,"^",5),"","VAFC MFU-TFL CLIENT",.HLL)
- IF '$DATA(HLL("LINKS"))
- DO XMITFLAG^VAFCDD01(LP,0,1)
- QUIT
- +36 KILL HLL
- +37 ;Update last treatment date and event reason
- +38 IF $$PATCH^XPDUTL("RG*1.0*4")
- DO EN1^RGADT2(PDFN,1)
- +39 IF PDFN
- Begin DoDot:2
- +40 KILL VAFCERR
- +41 IF $DATA(^DGCN(391.91,"APAT",PDFN))
- DO TFMFU(PDFN)
- +42 ;CALL TAG TO FLIP TRANSMIT FIELD IN VAT(391.71
- +43 if $GET(RESLT)
- DO XMITFLAG^VAFCDD01(LP,0,1)
- +44 ;store resulting message in ADT/HL7 PIVOT file
- +45 SET RESLT=$SELECT($GET(RESLT)]"":RESLT,1:$PIECE($GET(ER),U,2))
- +46 DO FILERM^VAFCUTL(LP,RESLT)
- +47 KILL ER,RESLT,VAFCERR
- QUIT
- End DoDot:2
- End DoDot:1
- BCKQ QUIT
- +1 ;
- TFMFU(PDFN) ;
- +1 ;sends a MFU message for a single patient
- +2 NEW HLEID
- +3 SET ER=$$INIT
- +4 IF ER
- GOTO TFMFUQ
- +5 DO BLDTFMFU(PDFN)
- +6 ;if error from build don't send
- +7 IF '$DATA(VAFCERR)
- DO SEND
- +8 DO KILLHL7
- TFMFUQ QUIT
- +1 ;
- INIT() ;
- +1 ;initialize HL7 variables
- +2 SET ER=0
- +3 SET HLEID=+$ORDER(^ORD(101,"B","VAFC MFU-TFL SERVER",0))
- +4 IF 'HLEID
- SET ER="1^Unable to initialize HL7 variables - Protocol not found."
- GOTO INITQ
- +5 SET HL=""
- +6 DO INIT^HLFNC2(HLEID,.HL)
- +7 IF $ORDER(HL(""))=""
- SET ER="1^"_$PIECE(HL,U,2)
- GOTO INITQ
- +8 IF $GET(HL)]""
- SET ER=$GET(HL)
- INITQ QUIT ER
- +1 ;
- +2 ;
- BLDTFMFU(PDFN) ;
- +1 ;builds the segments and formats the HL7 MFU message
- +2 NEW CTR,INST,ICN,INSTNUM,IEN,TF,EC,INSTNAM,PPF,CMOR
- +3 SET PPF=$$IFVCCI^MPIF001(PDFN)
- +4 SET EC=$EXTRACT(HL("ECH"),1,1)
- +5 SET CTR=1
- +6 SET TFMF(1)="TFL"
- SET TFMF(2)=""
- SET TFMF(3)=$SELECT(PPF>0:"REP",1:"UPD")
- SET TFMF(4)=""
- SET TFMF(5)=""
- SET TFMF(6)="NE"
- +7 SET CMOR=$$HL7CMOR^MPIF001(PDFN,EC)
- +8 IF CMOR'>0
- KILL CMOR
- +9 SET HLA("HLS",CTR)=$$EN^VAFHLMFI(HL("ECH"),HL("FS"),HL("Q"),"TFMF")_HL("FS")_$GET(CMOR)
- +10 KILL TFMF
- +11 SET ICN=$$GETICN^MPIF001(PDFN)
- +12 SET TFMF(1)="MAD"
- SET TFMF(2)=""
- +13 IF PPF>0
- Begin DoDot:1
- +14 FOR INST=0:0
- SET INST=$ORDER(^DGCN(391.91,"APAT",PDFN,INST))
- if 'INST
- QUIT
- SET IEN=$ORDER(^(INST,0))
- SET TF=^DGCN(391.91,IEN,0)
- Begin DoDot:2
- +15 SET INSTNAM=$$WHAT^XUAF4(+$PIECE(TF,U,2),.01)
- +16 SET INSTNUM=$$WHAT^XUAF4(+$PIECE(TF,U,2),99)
- +17 SET TFMF(3)=$$HLDATE^HLFNC($PIECE(TF,U,3))
- +18 SET TFMF(4)=INSTNUM_EC_INSTNAM_EC_"VA"_EC_+ICN_EC_"ICN"_EC_"VA"
- +19 DO SETMFE
- +20 DO SETZET(IEN)
- +21 QUIT
- End DoDot:2
- End DoDot:1
- +22 ;NOT THE PRIMARY FACILITY
- IF '$TEST
- Begin DoDot:1
- +23 SET INSTNAM=$$SITE^VASITE()
- SET INST=+INSTNAM
- +24 SET IEN=$ORDER(^DGCN(391.91,"APAT",PDFN,INST,0))
- +25 ;if there was a subscription but no TF add it, quit and don't send
- +26 IF +IEN'>0
- DO FILE^VAFCTFU(PDFN,INST,1)
- SET VAFCERR=1
- QUIT
- +27 SET TF=$GET(^DGCN(391.91,IEN,0))
- +28 SET TFMF(3)=$$HLDATE^HLFNC($PIECE(TF,"^",3))
- +29 SET TFMF(4)=$PIECE(INSTNAM,U,3)_EC_$PIECE(INSTNAM,U,2)_EC_"VA"_EC_+ICN_EC_"ICN"_EC_"VA"
- +30 DO SETMFE
- +31 DO SETZET(IEN)
- +32 QUIT
- End DoDot:1
- BLDTFMFQ KILL TFMF
- +1 QUIT
- +2 ;
- SETMFE SET CTR=CTR+1
- +1 SET HLA("HLS",CTR)=$$EN^VAFHLMFE(HL("ECH"),HL("FS"),HL("Q"),"TFMF")
- +2 QUIT
- SETZET(IEN) ;Date of Last Treatment event type ZET segment
- +1 SET CTR=CTR+1
- +2 SET HLA("HLS",CTR)="ZET"_HL("FS")_$$GET1^DIQ(391.91,+IEN_",",.07)
- +3 QUIT
- +4 ;
- SEND ;
- +1 ;sends the MFU message
- +2 DO GENERATE^HLMA(HLEID,"LM",1,.HLRESLT,"","")
- +3 SET RESLT=$SELECT(+HLRESLT:HLRESLT,1:$PIECE(HLRESLT,U,3))
- +4 QUIT
- +5 ;
- KILLHL7 ;
- +1 ;kills off the variables from the HL7 package.
- +2 KILL HL,HLA,HLECH,HLEID,HLFS,HLMTIEN,HLMTIENA,HLQ,HLRESLT,HLN,HLSAN
- +3 QUIT