IVMCMFB ;ALB/RMM - SEND INCOME TEST TRANSMISSION BULLETIN ; 07/24/03
;;2.0;INCOME VERIFICATION MATCH;**71,82**;21-OCT-94
;
BULL(DFN,DGMTDT,IVMERR,SCTST) ;
; Send mail message notifying site of an income test that was completed
; containing data inconsistencies.
;
; Input array required:
; "IVMERR(" -- contains lists of inconsistencies from tests
; which were uploaded (ORU~Z10 and ORF~Z10)
;
N DIFROM,XMDUZ,XMTEXT,XMSTRIP,XMROU,XMY,XMZ,XMDF,IVMGRP,IVMPAT
S XMDF=""
S XMDUZ=""
S XMTEXT="IVMTXT("
S XMY(DUZ)=""
S IVMGRP="MT INCONSISTENCIES"
S XMY("G."_IVMGRP_"@"_^XMB("NETNAME"))=""
S IVMPAT=$$PT^IVMUFNC4(DFN)
S XMSUB="MT INCONSISTENCIES - "_$E($P(IVMPAT,"^"),1)_$P(IVMPAT,"^",3)_"/"_SCTST
;
S IVMTXT(1)="An Income Test was edited/completed on "_$$FMTE^XLFDT($$NOW^XLFDT,"1D")
S IVMTXT(2)="containing "_($O(IVMERR(""),-1)-1)_" data inconsistencie(s)."
S IVMTXT(3)=" "
S IVMTXT(4)=" NAME: "_$P(IVMPAT,"^")
S IVMTXT(5)=" ID: "_$P(IVMPAT,"^",2)
S IVMTXT(6)=" TEST DATE: "_$$FMTE^XLFDT(DGMTDT)
S IVMTXT(7)=" "
S IVMTXT(8)="The inconsistencies are listed in the comment section of"
S IVMTXT(9)="the income test for this veteran."
;
D ^XMD
K IVMTXT,XMDUZ,XMSUB,XMTEXT,XMY
Q
;
PROB(DGMTDT,IVMERR,BULLRQ) ;
; IVMERR - Contains lists of inconsistencies from tests which were
; uploaded (ORU~Z10 and ORF~Z10) or created during data
; entry (Required)
;
; BULLRQ - MT INCONSISTENCIES Bulletin Required? flag (Optional)
;
; If the test wasn't completed during data entry quit
N MTCOMP,DGMTI,TYPE,SCTST
S BULLRQ=+$G(BULLRQ)
S TYPE=$S($D(IVMTYPE):IVMTYPE,$D(DGMTYPT):DGMTYPT,1:"")
S:'$D(DGMTI) DGMTI=+$$LST^DGMTU(DFN,,TYPE)
S MTCOMP=$P($G(^DGMT(408.31,+$G(DGMTI),0)),U,7)
I BULLRQ,MTCOMP'>0 Q
;
; If errors were found during data entry, send bulletin
S SCTST=$P($G(^DGMT(408.31,+$G(DGMTI),2)),U,5)
I BULLRQ,$D(IVMERR(2)) D BULL(DFN,DGMTDT,.IVMERR,SCTST)
;
; If inconsistent data was found update the comment field with the list
; of errors.
D INCON(DGMTI,.IVMERR)
Q
;
INCON(DGMTI,IVMERR,TFLG) ;
; Append the current comments (if any) with the list of inconsistencies
; found during data entry or upload of ORU/ORF Z10
N CNT,INCNT,COMM,TTYPE,TAB,ERR,LNCNT,TFLG
I $D(IVMERR(2)),BULLRQ D
.S TTYPE=^DG(408.33,+$P($G(^DGMT(408.31,DGMTI,0)),U,19),0)
.S IVMERR(1)=":A "_TTYPE_" was edited on "_$$FMTE^XLFDT($$NOW^XLFDT,"1P")_" with data inconsistencies."
I $D(IVMERR(2)),'BULLRQ D
.S IVMERR(1)=":Received/Uploaded Test on "_$$FMTE^XLFDT($$NOW^XLFDT,"1P")_" with data inconsistencies."
;
; Check for exisiting non-inconsistency messages
S TFLG=2
D CHECK(DGMTI,.TFLG)
;
; If nothing to add to the COMMENT field, delete all existing msgs
I '$D(IVMERR(1)) D INCONR(DGMTI) Q
;
; Overwrite the comments for inconsistencies found during Z10 upload
S TAB=": "
F LNCNT=TFLG:1 Q:'$D(IVMERR(LNCNT)) S IVMERR(LNCNT)=TAB_IVMERR(LNCNT)
D WP^DIE(408.31,DGMTI_",",50,,"IVMERR",.ERR)
Q
;
CHECK(DGMTI,TFLG) ;
; Check for exisiting non-inconsistency messages, and keep all
; non-inconsistency (user entered) messages.
;
; Quit if no comments were entered
Q:'$D(^DGMT(408.31,DGMTI,"C",1,0))
;
; Quit if all current comments are for inconsistencies
S INCNT=0
F CNT=1:1 Q:'$D(^DGMT(408.31,DGMTI,"C",CNT,0)) D
.Q:$E(^DGMT(408.31,DGMTI,"C",CNT,0),1)=":"
.Q:^DGMT(408.31,DGMTI,"C",CNT,0)']""
.S INCNT=INCNT+1,COMM(INCNT)=^DGMT(408.31,DGMTI,"C",CNT,0)
Q:INCNT'>0
;
; Re-Build Comment array with user comments
S TFLG=INCNT+2
F CNT=1:1 Q:'$D(IVMERR(CNT)) S INCNT=INCNT+1,COMM(INCNT)=IVMERR(CNT)
M IVMERR=COMM
Q
;
INCONR(DGMTI) ;
; When no inconsistent data and no user comments were found,
; remove everything from the COMMENT Word Procesing field.
;
; Quit if no comments exist
Q:'$D(^DGMT(408.31,DGMTI,"C",1,0))
;
; Delete all, when no comments and no inconsistencies
D WP^DIE(408.31,DGMTI_",",50,,"@",.ERR)
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIVMCMFB 4070 printed Dec 13, 2024@02:01:33 Page 2
IVMCMFB ;ALB/RMM - SEND INCOME TEST TRANSMISSION BULLETIN ; 07/24/03
+1 ;;2.0;INCOME VERIFICATION MATCH;**71,82**;21-OCT-94
+2 ;
BULL(DFN,DGMTDT,IVMERR,SCTST) ;
+1 ; Send mail message notifying site of an income test that was completed
+2 ; containing data inconsistencies.
+3 ;
+4 ; Input array required:
+5 ; "IVMERR(" -- contains lists of inconsistencies from tests
+6 ; which were uploaded (ORU~Z10 and ORF~Z10)
+7 ;
+8 NEW DIFROM,XMDUZ,XMTEXT,XMSTRIP,XMROU,XMY,XMZ,XMDF,IVMGRP,IVMPAT
+9 SET XMDF=""
+10 SET XMDUZ=""
+11 SET XMTEXT="IVMTXT("
+12 SET XMY(DUZ)=""
+13 SET IVMGRP="MT INCONSISTENCIES"
+14 SET XMY("G."_IVMGRP_"@"_^XMB("NETNAME"))=""
+15 SET IVMPAT=$$PT^IVMUFNC4(DFN)
+16 SET XMSUB="MT INCONSISTENCIES - "_$EXTRACT($PIECE(IVMPAT,"^"),1)_$PIECE(IVMPAT,"^",3)_"/"_SCTST
+17 ;
+18 SET IVMTXT(1)="An Income Test was edited/completed on "_$$FMTE^XLFDT($$NOW^XLFDT,"1D")
+19 SET IVMTXT(2)="containing "_($ORDER(IVMERR(""),-1)-1)_" data inconsistencie(s)."
+20 SET IVMTXT(3)=" "
+21 SET IVMTXT(4)=" NAME: "_$PIECE(IVMPAT,"^")
+22 SET IVMTXT(5)=" ID: "_$PIECE(IVMPAT,"^",2)
+23 SET IVMTXT(6)=" TEST DATE: "_$$FMTE^XLFDT(DGMTDT)
+24 SET IVMTXT(7)=" "
+25 SET IVMTXT(8)="The inconsistencies are listed in the comment section of"
+26 SET IVMTXT(9)="the income test for this veteran."
+27 ;
+28 DO ^XMD
+29 KILL IVMTXT,XMDUZ,XMSUB,XMTEXT,XMY
+30 QUIT
+31 ;
PROB(DGMTDT,IVMERR,BULLRQ) ;
+1 ; IVMERR - Contains lists of inconsistencies from tests which were
+2 ; uploaded (ORU~Z10 and ORF~Z10) or created during data
+3 ; entry (Required)
+4 ;
+5 ; BULLRQ - MT INCONSISTENCIES Bulletin Required? flag (Optional)
+6 ;
+7 ; If the test wasn't completed during data entry quit
+8 NEW MTCOMP,DGMTI,TYPE,SCTST
+9 SET BULLRQ=+$GET(BULLRQ)
+10 SET TYPE=$SELECT($DATA(IVMTYPE):IVMTYPE,$DATA(DGMTYPT):DGMTYPT,1:"")
+11 if '$DATA(DGMTI)
SET DGMTI=+$$LST^DGMTU(DFN,,TYPE)
+12 SET MTCOMP=$PIECE($GET(^DGMT(408.31,+$GET(DGMTI),0)),U,7)
+13 IF BULLRQ
IF MTCOMP'>0
QUIT
+14 ;
+15 ; If errors were found during data entry, send bulletin
+16 SET SCTST=$PIECE($GET(^DGMT(408.31,+$GET(DGMTI),2)),U,5)
+17 IF BULLRQ
IF $DATA(IVMERR(2))
DO BULL(DFN,DGMTDT,.IVMERR,SCTST)
+18 ;
+19 ; If inconsistent data was found update the comment field with the list
+20 ; of errors.
+21 DO INCON(DGMTI,.IVMERR)
+22 QUIT
+23 ;
INCON(DGMTI,IVMERR,TFLG) ;
+1 ; Append the current comments (if any) with the list of inconsistencies
+2 ; found during data entry or upload of ORU/ORF Z10
+3 NEW CNT,INCNT,COMM,TTYPE,TAB,ERR,LNCNT,TFLG
+4 IF $DATA(IVMERR(2))
IF BULLRQ
Begin DoDot:1
+5 SET TTYPE=^DG(408.33,+$PIECE($GET(^DGMT(408.31,DGMTI,0)),U,19),0)
+6 SET IVMERR(1)=":A "_TTYPE_" was edited on "_$$FMTE^XLFDT($$NOW^XLFDT,"1P")_" with data inconsistencies."
End DoDot:1
+7 IF $DATA(IVMERR(2))
IF 'BULLRQ
Begin DoDot:1
+8 SET IVMERR(1)=":Received/Uploaded Test on "_$$FMTE^XLFDT($$NOW^XLFDT,"1P")_" with data inconsistencies."
End DoDot:1
+9 ;
+10 ; Check for exisiting non-inconsistency messages
+11 SET TFLG=2
+12 DO CHECK(DGMTI,.TFLG)
+13 ;
+14 ; If nothing to add to the COMMENT field, delete all existing msgs
+15 IF '$DATA(IVMERR(1))
DO INCONR(DGMTI)
QUIT
+16 ;
+17 ; Overwrite the comments for inconsistencies found during Z10 upload
+18 SET TAB=": "
+19 FOR LNCNT=TFLG:1
if '$DATA(IVMERR(LNCNT))
QUIT
SET IVMERR(LNCNT)=TAB_IVMERR(LNCNT)
+20 DO WP^DIE(408.31,DGMTI_",",50,,"IVMERR",.ERR)
+21 QUIT
+22 ;
CHECK(DGMTI,TFLG) ;
+1 ; Check for exisiting non-inconsistency messages, and keep all
+2 ; non-inconsistency (user entered) messages.
+3 ;
+4 ; Quit if no comments were entered
+5 if '$DATA(^DGMT(408.31,DGMTI,"C",1,0))
QUIT
+6 ;
+7 ; Quit if all current comments are for inconsistencies
+8 SET INCNT=0
+9 FOR CNT=1:1
if '$DATA(^DGMT(408.31,DGMTI,"C",CNT,0))
QUIT
Begin DoDot:1
+10 if $EXTRACT(^DGMT(408.31,DGMTI,"C",CNT,0),1)="
QUIT
+11 if ^DGMT(408.31,DGMTI,"C",CNT,0)']""
QUIT
+12 SET INCNT=INCNT+1
SET COMM(INCNT)=^DGMT(408.31,DGMTI,"C",CNT,0)
End DoDot:1
+13 if INCNT'>0
QUIT
+14 ;
+15 ; Re-Build Comment array with user comments
+16 SET TFLG=INCNT+2
+17 FOR CNT=1:1
if '$DATA(IVMERR(CNT))
QUIT
SET INCNT=INCNT+1
SET COMM(INCNT)=IVMERR(CNT)
+18 MERGE IVMERR=COMM
+19 QUIT
+20 ;
INCONR(DGMTI) ;
+1 ; When no inconsistent data and no user comments were found,
+2 ; remove everything from the COMMENT Word Procesing field.
+3 ;
+4 ; Quit if no comments exist
+5 if '$DATA(^DGMT(408.31,DGMTI,"C",1,0))
QUIT
+6 ;
+7 ; Delete all, when no comments and no inconsistencies
+8 DO WP^DIE(408.31,DGMTI_",",50,,"@",.ERR)
+9 ;
+10 QUIT