- IVMPREC7 ;ALB/SEK,RTK - ROUTINE TO PROCESS INCOMING (Z06 EVENT TYPE) HL7 MESSAGES ; 31 May 94
- ;;2.0;INCOME VERIFICATION MATCH;**1,17,44,34,77**;21-OCT-94
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- ;
- ; This routine will process (validate) batch ORU Means Test(event type
- ; Z06) HL7 messages received from the IVM center. Format of batch:
- ; BHS
- ; {MSH
- ; PID
- ; ZIC
- ; ZIR
- ; {ZDP
- ; ZIC
- ; ZIR
- ; }
- ; ZMT
- ; }
- ; BTS
- ;
- EN ; entry point to validate Means Test messages
- ;
- F IVMDA=1:0 S IVMDA=$O(^TMP($J,IVMRTN,IVMDA)) Q:'IVMDA S IVMSEG=$G(^(IVMDA,0)) I $E(IVMSEG,1,3)="MSH" D Q:'IVMDA
- .K HLERR
- EN1 .S HLMID=$P(IVMSEG,HLFS,10) ; message control id from MSH
- .S IVMFLGC=0
- .D GET I IVMSEG1'="PID" D Q
- ..S HLERR="Missing PID segment" D ACK^IVMPREC
- .S DFN=$P($P(IVMSEG,HLFS,4),$E(HLECH))
- .I ('DFN!(DFN'=+DFN)!('$D(^DPT(+DFN,0)))) D Q
- ..S HLERR="Invalid DFN" D ACK^IVMPREC
- .I $P(IVMSEG,HLFS,20)'=$P(^DPT(DFN,0),"^",9) S HLERR="Couldn't match IVM SSN with DHCP SSN" D ACK^IVMPREC Q
- .S IVMDAP=IVMDA ; save IVMDA for veteran PID segment
- .;
- .; check for veteran's ZIC and ZIR segments
- .D GET I IVMSEG1'="ZIC" D Q
- ..S HLERR="Missing veteran's ZIC segment" D ACK^IVMPREC
- .S IVMDGLY=$P(IVMSEG,"^",3) ; income year
- .D GET I IVMSEG1'="ZIR" D Q
- ..S HLERR="Missing veteran's ZIR segment" D ACK^IVMPREC
- .;
- .; check for spouse's ZDP, ZIC, ZIR segments
- .D GET I IVMSEG1'="ZDP" D Q
- ..S HLERR="Missing spouse's ZDP segment" D ACK^IVMPREC
- .S IVMDAS=IVMDA ; save IVMDA for spouse ZDP segment
- .D GET I IVMSEG1'="ZIC" D Q
- ..S HLERR="Missing spouse's ZIC segment" D ACK^IVMPREC
- .D GET I IVMSEG1'="ZIR" D Q
- ..S HLERR="Missing spouse's ZIR segment" D ACK^IVMPREC
- .;
- .; check for dependent children's ZDP, ZIC, ZIR segments and ZMT segment
- .K IVMERR
- .S IVMFLG7=0
- .F D Q:$D(IVMERR)!(IVMSEG1="ZMT")
- ..D GET I IVMSEG1'="ZDP"&(IVMSEG1'="ZMT") D Q
- ...S HLERR="Missing child's ZDP segment or ZMT segment",IVMERR="" D ACK^IVMPREC
- ..I IVMSEG1="ZMT" D Q
- ...S:$P(IVMSEG,"^",4)=HLQ IVMFLG7=1 ; delete MT if status is HLQ
- ...S IVMDAZ=IVMDA ; ZMT segment ivmda
- ..I $P(IVMSEG,"^",2)']""!($P(IVMSEG,"^",3)']"")!($P(IVMSEG,"^",4)']"") D Q
- ... S HLERR="Missing child data from ZDP segment",IVMERR="" D ACK^IVMPREC
- ..D GET I IVMSEG1'="ZIC" D Q
- ...S HLERR="Missing child's ZIC segment",IVMERR="" D ACK^IVMPREC
- ..D GET I IVMSEG1'="ZIR" D Q
- ...S HLERR="Missing child's ZIR segment",IVMERR="" D ACK^IVMPREC
- ..S IVMFLGC=IVMFLGC+1 ; # of children
- .;
- .Q:$D(IVMERR)&(IVMSEG1'="MSH")
- .G EN1:IVMSEG1="MSH"
- .;
- .; get primary means test
- .; ivmmtdt - means test date
- .; dgly - income year
- .; if Means Test not in DHCP don't upload IVM Means Test
- .S IVMMTDT=$$FMDATE^HLFNC($P(IVMSEG,HLFS,3)) ; means test date from ZMT segment
- .S DGLY=$$LYR^DGMTSCU1(IVMMTDT)
- .S IVMMTIEN=+$$LST^DGMTU(DFN,IVMMTDT) ; primary means test IEN
- .;
- .I IVMFLG7 D ^IVMUM7 Q ; delete means test
- .;
- .S (IVMMT31,DGMTP)=$G(^DGMT(408.31,IVMMTIEN,0)) ; dgmtp is event driver variable
- .I $P(IVMMT31,"^")'=IVMMTDT D Q
- ..S Y=IVMMTDT X ^DD("DD")
- ..S IVMTEXT(6)="Means Test of "_Y_" not in DHCP."
- ..D ERRBULL,MAIL^IVMUFNC()
- ..S HLERR="Means test not in DHCP" D ACK^IVMPREC
- ..Q
- .I $P(IVMMT31,"^",23)=2 S Y=IVMMTDT X ^DD("DD") S HLERR="2nd means test sent for "_Y D ACK^IVMPREC Q
- .;
- .; do not upload IVM means test if primary means test status is
- .; 3-no longer required
- .; or if hardship case
- .S IVMSTAT=$P(IVMMT31,"^",3)
- .I IVMSTAT=3 S HLERR="NOT UPLOADED no longer required" D ACK^IVMPREC Q
- .I $P(IVMMT31,"^",20)=1 S HLERR="NOT UPLOADED hardship case" D ACK^IVMPREC Q
- .D ^IVMUM1 ; upload means test
- .I $D(HLERR) D ACK^IVMPREC
- .;
- .; cleanup
- .K DGLY,DGMTP,IVMDAP,IVMDAS,IVMDAZ,IVMDGLY,IVMFLG7,IVMFLGC,IVMMT31,IVMMTDT,IVMMTIEN,IVMSEG,IVMSEG1,IVMSTAT,IVMTEXT,XMSUB
- .Q
- Q
- ;
- GET ; get HL7 segment from ^HL
- S IVMDA=$O(^TMP($J,IVMRTN,+IVMDA)),IVMSEG=$G(^(+IVMDA,0))
- S IVMSEG1=$E(IVMSEG,1,3)
- Q
- ;
- ERRBULL ; build mail message for transmission to IVM mail group notifying site
- ; of upload error.
- S IVMPAT=$$PT^IVMUFNC4(DFN)
- S XMSUB="IVM - MEANS TEST UPLOAD"
- S IVMTEXT(1)="The following error occured when an Income Verification Match"
- S IVMTEXT(2)="verified Means Test was being uploaded for the following patient:"
- S IVMTEXT(3)=" "
- S IVMTEXT(4)=" NAME: "_$P(IVMPAT,"^")
- S IVMTEXT(5)=" ID: "_$P(IVMPAT,"^",2)
- S IVMTEXT(6)=" ERROR: "_IVMTEXT(6)
- Q
- ORF ;entry point for Means Test Signature Z06 msgs.
- I $G(HLFS)="" S HLFS="^"
- I $G(HLECH)="" S HLECH="~"
- F IVMDA=0:0 S IVMDA=$O(^TMP($J,IVMRTN,IVMDA)) Q:'IVMDA S IVMSEG=$G(^(IVMDA,0)) I $E(IVMSEG,1,3)="MSH" D Q:'IVMDA
- .K HLERR
- .S HLMID=$P(IVMSEG,HLFS,10) ; message control id from MSH
- .S IVMFLGC=0
- .D GET I IVMSEG1'="PID" D Q
- ..S HLERR="Missing PID segment" D ACK^IVMPREC
- .S DFN=$P($P(IVMSEG,HLFS,4),$E(HLECH))
- .I ('DFN!(DFN'=+DFN)!('$D(^DPT(+DFN,0)))) D Q
- ..S HLERR="Invalid DFN" D ACK^IVMPREC
- .I $P(IVMSEG,HLFS,20)'=$P(^DPT(DFN,0),"^",9) S HLERR="Couldn't match IVMSSN with DHCP SSN" D ACK^IVMPREC Q
- .S IVMDAP=IVMDA ; save IVMDA for veteran PID segment
- .D GET I IVMSEG1'="ZMT" D Q
- ..S HLERR="Missing ZMT segment" D ACK^IVMPREC
- .; IVMMTDT - means test date
- .; DGLY - income year
- .; if Means Test not in DHCP don't upload IVM Means Test
- .S IVMMTDT=$$FMDATE^HLFNC($P(IVMSEG,HLFS,3)) ; means test date from ZMT segment
- .S DGLY=$$LYR^DGMTSCU1(IVMMTDT)
- .; get means test to be updated
- .N UPMTS
- .S MTDATE=-IVMMTDT,IVMMTIEN="",MTFND=0
- .F S IVMMTIEN=$O(^DGMT(408.31,"AID",1,DFN,MTDATE,IVMMTIEN),-1) Q:MTFND!(IVMMTIEN="") D
- ..I $$Z06MT^EASPTRN1(IVMMTIEN) Q ;EDB Z06 - Don't use this one
- ..; match site completing in case multiple tests for same date
- ..I $P(IVMSEG,HLFS,23)=$P(^DGMT(408.31,IVMMTIEN,2),HLFS,5) S UPMTS=IVMMTIEN,MTFND=1 Q
- .S (IVMMT31,DGMTP)=$G(^DGMT(408.31,UPMTS,0)) ; DGMTP is event driver variable
- .I $P(IVMMT31,"^")'=IVMMTDT D Q
- ..S Y=IVMMTDT X ^DD("DD")
- ..S IVMTEXT(6)="Means Test of "_Y_" not in DHCP."
- ..D ERRBULL,MAIL^IVMUFNC()
- ..S HLERR="Means test not in DHCP" D ACK^IVMPREC
- ..Q
- .I $P(IVMMT31,"^",23)=2 S Y=IVMMTDT X ^DD("DD") S HLERR="2nd means test sent for "_Y D ACK^IVMPREC Q
- .; do not upload IVM means test if primary means test status is
- .; 3-no longer required
- .; or if hardship case
- .S IVMSTAT=$P(IVMMT31,"^",3)
- .I IVMSTAT=3 S HLERR="NOT UPLOADED no longer required" D ACK^IVMPREC Q
- .I $P(IVMMT31,"^",20)=1 S HLERR="NOT UPLOADED hardship case" D ACK^IVMPREC Q
- .;get MT signature and date/time edited info, update means test
- .N DATA
- .S DATA(.29)=$P(IVMSEG,HLFS,28),DATA(2.02)=$$FMDATE^HLFNC($P(IVMSEG,HLFS,26)) I $D(DATA(.29)) D
- ..I $$UPD^DGENDBS(408.31,UPMTS,.DATA)
- .I '$D(HLERR) D ACK^IVMPREC
- .;
- .; cleanup
- .K DGLY,DGMTP,IVMDAP,IVMDAS,IVMDAZ,IVMDGLY,IVMFLG7,IVMFLGC,IVMMT31,IVMMTDT,IVMMTIEN,IVMSEG,IVMSEG1,IVMSTAT,IVMTEXT,XMSUB,FMDATE,MTDATE
- .Q
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIVMPREC7 7090 printed Feb 18, 2025@23:27:54 Page 2
- IVMPREC7 ;ALB/SEK,RTK - ROUTINE TO PROCESS INCOMING (Z06 EVENT TYPE) HL7 MESSAGES ; 31 May 94
- +1 ;;2.0;INCOME VERIFICATION MATCH;**1,17,44,34,77**;21-OCT-94
- +2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 ;
- +4 ; This routine will process (validate) batch ORU Means Test(event type
- +5 ; Z06) HL7 messages received from the IVM center. Format of batch:
- +6 ; BHS
- +7 ; {MSH
- +8 ; PID
- +9 ; ZIC
- +10 ; ZIR
- +11 ; {ZDP
- +12 ; ZIC
- +13 ; ZIR
- +14 ; }
- +15 ; ZMT
- +16 ; }
- +17 ; BTS
- +18 ;
- EN ; entry point to validate Means Test messages
- +1 ;
- +2 FOR IVMDA=1:0
- SET IVMDA=$ORDER(^TMP($JOB,IVMRTN,IVMDA))
- if 'IVMDA
- QUIT
- SET IVMSEG=$GET(^(IVMDA,0))
- IF $EXTRACT(IVMSEG,1,3)="MSH"
- Begin DoDot:1
- +3 KILL HLERR
- EN1 ; message control id from MSH
- SET HLMID=$PIECE(IVMSEG,HLFS,10)
- +1 SET IVMFLGC=0
- +2 DO GET
- IF IVMSEG1'="PID"
- Begin DoDot:2
- +3 SET HLERR="Missing PID segment"
- DO ACK^IVMPREC
- End DoDot:2
- QUIT
- +4 SET DFN=$PIECE($PIECE(IVMSEG,HLFS,4),$EXTRACT(HLECH))
- +5 IF ('DFN!(DFN'=+DFN)!('$DATA(^DPT(+DFN,0))))
- Begin DoDot:2
- +6 SET HLERR="Invalid DFN"
- DO ACK^IVMPREC
- End DoDot:2
- QUIT
- +7 IF $PIECE(IVMSEG,HLFS,20)'=$PIECE(^DPT(DFN,0),"^",9)
- SET HLERR="Couldn't match IVM SSN with DHCP SSN"
- DO ACK^IVMPREC
- QUIT
- +8 ; save IVMDA for veteran PID segment
- SET IVMDAP=IVMDA
- +9 ;
- +10 ; check for veteran's ZIC and ZIR segments
- +11 DO GET
- IF IVMSEG1'="ZIC"
- Begin DoDot:2
- +12 SET HLERR="Missing veteran's ZIC segment"
- DO ACK^IVMPREC
- End DoDot:2
- QUIT
- +13 ; income year
- SET IVMDGLY=$PIECE(IVMSEG,"^",3)
- +14 DO GET
- IF IVMSEG1'="ZIR"
- Begin DoDot:2
- +15 SET HLERR="Missing veteran's ZIR segment"
- DO ACK^IVMPREC
- End DoDot:2
- QUIT
- +16 ;
- +17 ; check for spouse's ZDP, ZIC, ZIR segments
- +18 DO GET
- IF IVMSEG1'="ZDP"
- Begin DoDot:2
- +19 SET HLERR="Missing spouse's ZDP segment"
- DO ACK^IVMPREC
- End DoDot:2
- QUIT
- +20 ; save IVMDA for spouse ZDP segment
- SET IVMDAS=IVMDA
- +21 DO GET
- IF IVMSEG1'="ZIC"
- Begin DoDot:2
- +22 SET HLERR="Missing spouse's ZIC segment"
- DO ACK^IVMPREC
- End DoDot:2
- QUIT
- +23 DO GET
- IF IVMSEG1'="ZIR"
- Begin DoDot:2
- +24 SET HLERR="Missing spouse's ZIR segment"
- DO ACK^IVMPREC
- End DoDot:2
- QUIT
- +25 ;
- +26 ; check for dependent children's ZDP, ZIC, ZIR segments and ZMT segment
- +27 KILL IVMERR
- +28 SET IVMFLG7=0
- +29 FOR
- Begin DoDot:2
- +30 DO GET
- IF IVMSEG1'="ZDP"&(IVMSEG1'="ZMT")
- Begin DoDot:3
- +31 SET HLERR="Missing child's ZDP segment or ZMT segment"
- SET IVMERR=""
- DO ACK^IVMPREC
- End DoDot:3
- QUIT
- +32 IF IVMSEG1="ZMT"
- Begin DoDot:3
- +33 ; delete MT if status is HLQ
- if $PIECE(IVMSEG,"^",4)=HLQ
- SET IVMFLG7=1
- +34 ; ZMT segment ivmda
- SET IVMDAZ=IVMDA
- End DoDot:3
- QUIT
- +35 IF $PIECE(IVMSEG,"^",2)']""!($PIECE(IVMSEG,"^",3)']"")!($PIECE(IVMSEG,"^",4)']"")
- Begin DoDot:3
- +36 SET HLERR="Missing child data from ZDP segment"
- SET IVMERR=""
- DO ACK^IVMPREC
- End DoDot:3
- QUIT
- +37 DO GET
- IF IVMSEG1'="ZIC"
- Begin DoDot:3
- +38 SET HLERR="Missing child's ZIC segment"
- SET IVMERR=""
- DO ACK^IVMPREC
- End DoDot:3
- QUIT
- +39 DO GET
- IF IVMSEG1'="ZIR"
- Begin DoDot:3
- +40 SET HLERR="Missing child's ZIR segment"
- SET IVMERR=""
- DO ACK^IVMPREC
- End DoDot:3
- QUIT
- +41 ; # of children
- SET IVMFLGC=IVMFLGC+1
- End DoDot:2
- if $DATA(IVMERR)!(IVMSEG1="ZMT")
- QUIT
- +42 ;
- +43 if $DATA(IVMERR)&(IVMSEG1'="MSH")
- QUIT
- +44 if IVMSEG1="MSH"
- GOTO EN1
- +45 ;
- +46 ; get primary means test
- +47 ; ivmmtdt - means test date
- +48 ; dgly - income year
- +49 ; if Means Test not in DHCP don't upload IVM Means Test
- +50 ; means test date from ZMT segment
- SET IVMMTDT=$$FMDATE^HLFNC($PIECE(IVMSEG,HLFS,3))
- +51 SET DGLY=$$LYR^DGMTSCU1(IVMMTDT)
- +52 ; primary means test IEN
- SET IVMMTIEN=+$$LST^DGMTU(DFN,IVMMTDT)
- +53 ;
- +54 ; delete means test
- IF IVMFLG7
- DO ^IVMUM7
- QUIT
- +55 ;
- +56 ; dgmtp is event driver variable
- SET (IVMMT31,DGMTP)=$GET(^DGMT(408.31,IVMMTIEN,0))
- +57 IF $PIECE(IVMMT31,"^")'=IVMMTDT
- Begin DoDot:2
- +58 SET Y=IVMMTDT
- XECUTE ^DD("DD")
- +59 SET IVMTEXT(6)="Means Test of "_Y_" not in DHCP."
- +60 DO ERRBULL
- DO MAIL^IVMUFNC()
- +61 SET HLERR="Means test not in DHCP"
- DO ACK^IVMPREC
- +62 QUIT
- End DoDot:2
- QUIT
- +63 IF $PIECE(IVMMT31,"^",23)=2
- SET Y=IVMMTDT
- XECUTE ^DD("DD")
- SET HLERR="2nd means test sent for "_Y
- DO ACK^IVMPREC
- QUIT
- +64 ;
- +65 ; do not upload IVM means test if primary means test status is
- +66 ; 3-no longer required
- +67 ; or if hardship case
- +68 SET IVMSTAT=$PIECE(IVMMT31,"^",3)
- +69 IF IVMSTAT=3
- SET HLERR="NOT UPLOADED no longer required"
- DO ACK^IVMPREC
- QUIT
- +70 IF $PIECE(IVMMT31,"^",20)=1
- SET HLERR="NOT UPLOADED hardship case"
- DO ACK^IVMPREC
- QUIT
- +71 ; upload means test
- DO ^IVMUM1
- +72 IF $DATA(HLERR)
- DO ACK^IVMPREC
- +73 ;
- +74 ; cleanup
- +75 KILL DGLY,DGMTP,IVMDAP,IVMDAS,IVMDAZ,IVMDGLY,IVMFLG7,IVMFLGC,IVMMT31,IVMMTDT,IVMMTIEN,IVMSEG,IVMSEG1,IVMSTAT,IVMTEXT,XMSUB
- +76 QUIT
- End DoDot:1
- if 'IVMDA
- QUIT
- +77 QUIT
- +78 ;
- GET ; get HL7 segment from ^HL
- +1 SET IVMDA=$ORDER(^TMP($JOB,IVMRTN,+IVMDA))
- SET IVMSEG=$GET(^(+IVMDA,0))
- +2 SET IVMSEG1=$EXTRACT(IVMSEG,1,3)
- +3 QUIT
- +4 ;
- ERRBULL ; build mail message for transmission to IVM mail group notifying site
- +1 ; of upload error.
- +2 SET IVMPAT=$$PT^IVMUFNC4(DFN)
- +3 SET XMSUB="IVM - MEANS TEST UPLOAD"
- +4 SET IVMTEXT(1)="The following error occured when an Income Verification Match"
- +5 SET IVMTEXT(2)="verified Means Test was being uploaded for the following patient:"
- +6 SET IVMTEXT(3)=" "
- +7 SET IVMTEXT(4)=" NAME: "_$PIECE(IVMPAT,"^")
- +8 SET IVMTEXT(5)=" ID: "_$PIECE(IVMPAT,"^",2)
- +9 SET IVMTEXT(6)=" ERROR: "_IVMTEXT(6)
- +10 QUIT
- ORF ;entry point for Means Test Signature Z06 msgs.
- +1 IF $GET(HLFS)=""
- SET HLFS="^"
- +2 IF $GET(HLECH)=""
- SET HLECH="~"
- +3 FOR IVMDA=0:0
- SET IVMDA=$ORDER(^TMP($JOB,IVMRTN,IVMDA))
- if 'IVMDA
- QUIT
- SET IVMSEG=$GET(^(IVMDA,0))
- IF $EXTRACT(IVMSEG,1,3)="MSH"
- Begin DoDot:1
- +4 KILL HLERR
- +5 ; message control id from MSH
- SET HLMID=$PIECE(IVMSEG,HLFS,10)
- +6 SET IVMFLGC=0
- +7 DO GET
- IF IVMSEG1'="PID"
- Begin DoDot:2
- +8 SET HLERR="Missing PID segment"
- DO ACK^IVMPREC
- End DoDot:2
- QUIT
- +9 SET DFN=$PIECE($PIECE(IVMSEG,HLFS,4),$EXTRACT(HLECH))
- +10 IF ('DFN!(DFN'=+DFN)!('$DATA(^DPT(+DFN,0))))
- Begin DoDot:2
- +11 SET HLERR="Invalid DFN"
- DO ACK^IVMPREC
- End DoDot:2
- QUIT
- +12 IF $PIECE(IVMSEG,HLFS,20)'=$PIECE(^DPT(DFN,0),"^",9)
- SET HLERR="Couldn't match IVMSSN with DHCP SSN"
- DO ACK^IVMPREC
- QUIT
- +13 ; save IVMDA for veteran PID segment
- SET IVMDAP=IVMDA
- +14 DO GET
- IF IVMSEG1'="ZMT"
- Begin DoDot:2
- +15 SET HLERR="Missing ZMT segment"
- DO ACK^IVMPREC
- End DoDot:2
- QUIT
- +16 ; IVMMTDT - means test date
- +17 ; DGLY - income year
- +18 ; if Means Test not in DHCP don't upload IVM Means Test
- +19 ; means test date from ZMT segment
- SET IVMMTDT=$$FMDATE^HLFNC($PIECE(IVMSEG,HLFS,3))
- +20 SET DGLY=$$LYR^DGMTSCU1(IVMMTDT)
- +21 ; get means test to be updated
- +22 NEW UPMTS
- +23 SET MTDATE=-IVMMTDT
- SET IVMMTIEN=""
- SET MTFND=0
- +24 FOR
- SET IVMMTIEN=$ORDER(^DGMT(408.31,"AID",1,DFN,MTDATE,IVMMTIEN),-1)
- if MTFND!(IVMMTIEN="")
- QUIT
- Begin DoDot:2
- +25 ;EDB Z06 - Don't use this one
- IF $$Z06MT^EASPTRN1(IVMMTIEN)
- QUIT
- +26 ; match site completing in case multiple tests for same date
- +27 IF $PIECE(IVMSEG,HLFS,23)=$PIECE(^DGMT(408.31,IVMMTIEN,2),HLFS,5)
- SET UPMTS=IVMMTIEN
- SET MTFND=1
- QUIT
- End DoDot:2
- +28 ; DGMTP is event driver variable
- SET (IVMMT31,DGMTP)=$GET(^DGMT(408.31,UPMTS,0))
- +29 IF $PIECE(IVMMT31,"^")'=IVMMTDT
- Begin DoDot:2
- +30 SET Y=IVMMTDT
- XECUTE ^DD("DD")
- +31 SET IVMTEXT(6)="Means Test of "_Y_" not in DHCP."
- +32 DO ERRBULL
- DO MAIL^IVMUFNC()
- +33 SET HLERR="Means test not in DHCP"
- DO ACK^IVMPREC
- +34 QUIT
- End DoDot:2
- QUIT
- +35 IF $PIECE(IVMMT31,"^",23)=2
- SET Y=IVMMTDT
- XECUTE ^DD("DD")
- SET HLERR="2nd means test sent for "_Y
- DO ACK^IVMPREC
- QUIT
- +36 ; do not upload IVM means test if primary means test status is
- +37 ; 3-no longer required
- +38 ; or if hardship case
- +39 SET IVMSTAT=$PIECE(IVMMT31,"^",3)
- +40 IF IVMSTAT=3
- SET HLERR="NOT UPLOADED no longer required"
- DO ACK^IVMPREC
- QUIT
- +41 IF $PIECE(IVMMT31,"^",20)=1
- SET HLERR="NOT UPLOADED hardship case"
- DO ACK^IVMPREC
- QUIT
- +42 ;get MT signature and date/time edited info, update means test
- +43 NEW DATA
- +44 SET DATA(.29)=$PIECE(IVMSEG,HLFS,28)
- SET DATA(2.02)=$$FMDATE^HLFNC($PIECE(IVMSEG,HLFS,26))
- IF $DATA(DATA(.29))
- Begin DoDot:2
- +45 IF $$UPD^DGENDBS(408.31,UPMTS,.DATA)
- End DoDot:2
- +46 IF '$DATA(HLERR)
- DO ACK^IVMPREC
- +47 ;
- +48 ; cleanup
- +49 KILL DGLY,DGMTP,IVMDAP,IVMDAS,IVMDAZ,IVMDGLY,IVMFLG7,IVMFLGC,IVMMT31,IVMMTDT,IVMMTIEN,IVMSEG,IVMSEG1,IVMSTAT,IVMTEXT,XMSUB,FMDATE,MTDATE
- +50 QUIT
- End DoDot:1
- if 'IVMDA
- QUIT
- +51 QUIT