IVMLDEM9 ;ALB/BRM/PHH/LBD/JAM - IVM ADDRESS UPDATES PENDING REVIEW RPT ;4/18/12 4:43pm
;;2.0;INCOME VERIFICATION MATCH;**79,93,119,126,133,152,177**;21-OCT-94;Build 3
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
Q
;
EN2 ;entry point for IVM ADDR UPDT PENDING REVIEW menu option
K ^TMP("IVMLDEM9",$J)
K ^TMP($J,"IVMLDEM9")
;If mail group has no member or remote-member
I '$$MEMBER() D Q
. I '$D(ZTQUEUED) W !!,"IVM ADDR UPDT REPORT does not have a member. Report not sent." K DIR S DIR(0)="E" D ^DIR K DIR
I +$G(ZTSK) D PRINT,EXIT Q ;started by Taskman job
;User runs the option
I '$D(ZTQUEUED) D
. W !!,"The report will be sent to mail group IVM ADDR UPDT REPORT"
. D QUE
. D EXIT
. K DIR S DIR(0)="E" D ^DIR K DIR
Q
;
LOOP(DTPARAM,FILDAT) ;main loop
N DFN,IVMDT,IVMDA,IVMDA1,IVMDA2,RF171,TODAY,AUTODT,DTDIFF,NAME,UPLDT
N X1,X2,Y,SSN,DFN
D DT^DILF("X","T"_$G(DTPARAM),.AUTODT)
S TODAY=$$DT^XLFDT S:'$G(FILDAT) FILDAT=0
Q:'$G(AUTODT) ;this should never occur, but just in case
S RF171=$O(^IVM(301.92,"C","RF171","")),IVMDA2=""
Q:'RF171
F S IVMDA2=$O(^IVM(301.5,IVMDA2)) Q:IVMDA2="" D
.S DFN=$P($G(^IVM(301.5,IVMDA2,0)),"^"),IVMDA1=""
.Q:('DFN)!('$D(^DPT(+DFN)))!('$D(^IVM(301.5,IVMDA2,"IN")))
.F S IVMDA1=$O(^IVM(301.5,IVMDA2,"IN",IVMDA1)) Q:IVMDA1="" D
..Q:'$D(^IVM(301.5,IVMDA2,"IN",IVMDA1,"DEM","B",RF171))
..S IVMDA=""
..F S IVMDA=$O(^IVM(301.5,IVMDA2,"IN",IVMDA1,"DEM","B",RF171,IVMDA)) Q:'IVMDA D
...S IVMDT=$P($G(^IVM(301.5,IVMDA2,"IN",IVMDA1,"DEM",IVMDA,0)),"^",3)
...Q:('IVMDT)!(IVMDT>AUTODT)
...; report addresses that will be auto-uploaded in DTDIFF days
...S X1=TODAY,X2=IVMDT D ^%DTC S DTDIFF=+$G(X)
...S NAME=$P($G(^DPT(DFN,0)),"^"),SSN=$P($G(^DPT(DFN,0)),"^",9)
...S X1=IVMDT,X2=14 D C^%DTC S UPLDT=$G(X)
...I '$D(^IVM(301.5,"ASEG","PID",IVMDA2)) Q
...S ^TMP("IVMLDEM9",$J,DTDIFF,SSN,IVMDA)=$G(NAME)_"^"_$P(IVMDT,".")_"^"_$P(UPLDT,".")_"^"_DFN_"^"_IVMDA2_"^"_IVMDA1
Q
;
AUTOLOAD(DFN,IVMDA2,IVMDA1) ;auto-upload records that not been reviewed
; this tag is called from ^IVMLDEMC
;
Q:('$G(DFN))!('$G(IVMDA2))!('$G(IVMDA1))
N IVMI,IVMJ,IVMFIELD,IVMVALUE,IVMNODE,IVMFLAG,DUZ
S DUZ=.5
;
; determine appropriate address change dt/tm to be used
D ADDRDT^IVMLDEM6(DFN,IVMDA2,IVMDA1)
;
N DGPRIOR D GETPRIOR^DGADDUTL(DFN,.DGPRIOR)
;
; loop through the record to be uploaded
S IVMI=0 F S IVMI=$O(^IVM(301.92,"AD",IVMI)) Q:IVMI']"" D
.S IVMJ=0 F S IVMJ=$O(^IVM(301.5,IVMDA2,"IN",IVMDA1,"DEM","B",IVMI,IVMJ)) Q:IVMJ']"" D
..;
..; check for data node in (#301.511) sub-file
..S IVMNODE=$G(^IVM(301.5,IVMDA2,"IN",IVMDA1,"DEM",IVMJ,0))
..Q:('+IVMNODE)!($P(IVMNODE,"^",2)']"")
..;
..; check for residence phone number -> do not auto-upload
..Q:(+IVMNODE=$O(^IVM(301.92,"B","PHONE NUMBER [RESIDENCE]",0)))
..;
..; IVM*2.0*177 ; jam; Comment lines below to skip over reject/upload logic for these records and just do cleanup
..;
..; do not auto-upload if there is an active prescription
..;I $$PHARM^IVMLDEM6(+DFN) D REJTADD Q
..;
..; set upload parameters
..;S IVMFIELD=$P($G(^IVM(301.92,+IVMNODE,0)),"^",5)
..;S IVMVALUE=$P(IVMNODE,"^",2)
..;
..; load addr field into the Patient (#2) file
..;D UPLOAD^IVMLDEM6(DFN,IVMFIELD,IVMVALUE) S IVMFLAG=1
..;
..; remove entry from (#301.511) sub-file
..D DELENT^IVMLDEMU(IVMDA2,IVMDA1,IVMJ)
..;
..; if no display or uploadable fields, delete PID segment
..I ('$$DEMO^IVMLDEM5(IVMDA2,IVMDA1,0))&('$$DEMO^IVMLDEM5(IVMDA2,IVMDA1,1)) D DELETE^IVMLDEM5(IVMDA2,IVMDA1," ")
;
I +$G(IVMFLAG) D
.N DGCURR
.D GETUPDTS^DGADDUTL(DFN,.DGCURR)
.D UPDADDLG^DGADDUTL(DFN,.DGPRIOR,.DGCURR)
Q
REJTADD ;Reject the address
;
; update the ADDRESS CHANGE DT/TM field #.118 in PATIENT file #2
D UPDDTTM^DGADDUTL(DFN,"PERM")
;
; trigger the record to transmit the existing address on file to HEC
N DGENUPLD ; Used in SETSTAT^IVMPLOG to prevent filing.
N DA,X,IVMX
S (DA,X)=DFN
S IVMX=X,X="IVMPXFR" X ^%ZOSF("TEST") D:$T DPT^IVMPXFR S X=IVMX
Q
PRINT ;report output
N DAYS,SSN,DATA,EX,PAGE,IVMDA,DATA,IVMLN,XMY,XMSUB,XMDUZ,XMTEXT
D LOOP("",0)
D HDR
D DISPLAY
D EMAIL
Q
DISPLAY ;Display the report
S DAYS=""
I '$D(^TMP("IVMLDEM9",$J)) Q
F S DAYS=$O(^TMP("IVMLDEM9",$J,DAYS),-1) Q:DAYS=""!($G(EX)) D
.S SSN=""
.F S SSN=$O(^TMP("IVMLDEM9",$J,DAYS,SSN)) Q:SSN=""!($G(EX)) D
..S IVMDA=""
..F S IVMDA=$O(^TMP("IVMLDEM9",$J,DAYS,SSN,IVMDA)) Q:(IVMDA="")!($G(EX)) D
...S DATA=$G(^TMP("IVMLDEM9",$J,DAYS,SSN,IVMDA))
... D LNPLUS
... S ^TMP($J,"IVMLDEM9",IVMLN)=" "_$$FMTE^XLFDT($P(DATA,"^",3))_" "_$$FMTE^XLFDT($P(DATA,"^",2))_" "_SSN_" "_$P(DATA,"^")
... S ^TMP($J,"IVMLDEM9","TOTAL")=$G(^TMP($J,"IVMLDEM9","TOTAL"))+1
D TOTAL
D
. D LNPLUS
. S ^TMP($J,"IVMLDEM9",IVMLN)=""
. D LNPLUS
. S ^TMP($J,"IVMLDEM9",IVMLN)=" <<END OF REPORT>>"
I $E(IOST)="C" W ! K DIR S DIR(0)="E" D ^DIR K DIR
Q
HDR ;print header
N IVMDT,Y,DLINE
I $D(ZTQUEUED),$$S^%ZTLOAD S (ZTSTOP,EX)=1 Q
S Y=DT X ^DD("DD") S IVMDT=Y
D
. D LNPLUS
. S ^TMP($J,"IVMLDEM9",IVMLN)=""
. D LNPLUS
. S ^TMP($J,"IVMLDEM9",IVMLN)=" IVM ADDRESS UPDATES PENDING REVIEW "_IVMDT
. D LNPLUS
. S $P(^TMP($J,"IVMLDEM9",IVMLN),"=",78)=""
. D LNPLUS
. S ^TMP($J,"IVMLDEM9",IVMLN)=""
. D LNPLUS
. S ^TMP($J,"IVMLDEM9",IVMLN)=" Auto-Upload Date Date Received SSN Patient Name"
. D LNPLUS
. S ^TMP($J,"IVMLDEM9",IVMLN)=" ---------------- ------------- --------- ------------"
Q
EXIT D ^%ZISC,HOME^%ZIS Q
K ^TMP($J,"IVMLDEM9")
K ^TMP("IVMLDEM9",$J)
;
ADRDTCK(DFN,IVMDA2,IVMDA1) ;is the incoming address older than #2 address?
Q:'$G(DFN)!('$G(IVMDA2))!('$G(IVMDA1)) "0^MISSING INPUT PARAMETER"
N OADDRDT,NADDRDT,ERR,IVMDA,IEN92,IENS
S OADDRDT=$$GET1^DIQ(2,DFN_",",.118,"I","","ERR") Q:$D(ERR) "0^OLD ADDR ERROR"
S IEN92=$O(^IVM(301.92,"C","RF171","")) Q:'IEN92 "0^BAD #301.92 ENTRY FOR RF171"
I '$D(^IVM(301.5,IVMDA2,"IN",IVMDA1,"DEM","B",IEN92)) Q "0^ADDR DT NOT PRESENT"
S IVMDA=$O(^IVM(301.5,IVMDA2,"IN",IVMDA1,"DEM","B",IEN92,"")) Q:'IVMDA "0^MISSING ADDR DT IN 301.5"
S IENS=IVMDA_","_IVMDA1_","_IVMDA2_","
S NADDRDT=$$GET1^DIQ(301.511,IENS,.02,"I","","ERR") Q:$D(ERR) "0^NEW ADDR ERROR"
Q:(OADDRDT="")&(NADDRDT="") 0
Q:(NADDRDT="")!(OADDRDT'<NADDRDT) 1
Q "0^INCOMING ADDRESS IS NEWER THAN PATIENT FILE ADDR"
;
PHNDTCK(DFN,IVMDA2,IVMDA1) ;is the incoming phone # older than #2 phone #?
Q:'$G(DFN)!('$G(IVMDA2))!('$G(IVMDA1)) "0^MISSING INPUT PARAMETER"
N OPHNDT,NPHNDT,ERR,IVMDA,IEN92,IENS
S OPHNDT=$$GET1^DIQ(2,DFN_",",.1321,"I","","ERR") Q:$D(ERR) "0^OLD PHN ERROR"
S IEN92=$O(^IVM(301.92,"C","RF171P","")) Q:'IEN92 "0^BAD #301.92 ENTRY FOR RF171P"
I '$D(^IVM(301.5,IVMDA2,"IN",IVMDA1,"DEM","B",IEN92)) Q "0^PHN DT NOT PRESENT"
S IVMDA=$O(^IVM(301.5,IVMDA2,"IN",IVMDA1,"DEM","B",IEN92,"")) Q:'IVMDA "0^MISSING PHN DT IN 301.5"
S IENS=IVMDA_","_IVMDA1_","_IVMDA2_","
S NPHNDT=$$GET1^DIQ(301.511,IENS,.02,"I","","ERR") Q:$D(ERR) "0^NEW PHN ERROR"
Q:(OPHNDT="")&(NPHNDT="") 0
Q:(NPHNDT="")!(OPHNDT'<NPHNDT) 1
Q "0^INCOMING PHONE # IS NEWER THAN PATIENT FILE PHONE #"
;
MEMBER() ;Return 0 if mail group has no local or remote member
N RESULT,IVMIEN,IVMRMT
S RESULT=1
S IVMIEN=$$FIND1^DIC(3.8,"","X","IVM ADDR UPDT REPORT")
D LIST^DIC(3.812,","_IVMIEN_",",.01,"P","","","","","","","IVMRMT")
I ($P($G(IVMRMT("DILIST",0)),U)'>0),('$$GOTLOCAL^XMXAPIG("IVM ADDR UPDT REPORT")) S RESULT=0
Q RESULT
EMAIL ;Set up parameters to email the report
;If called within a task, protect variables
I $D(ZTQUEUED) N %,DIFROM
N RDT
D NOW^%DTC S Y=% X ^DD("DD")
S RDT=$P(Y,"@",1)_"@"_$P($P(Y,"@",2),":",1,2)
S XMSUB="IVM Address Pending Review ("_RDT_")"
S XMY("G.IVM ADDR UPDT REPORT")=""
I $G(^TMP($J,"IVMLDEM9","TOTAL"))<1 D
. D LNPLUS
. S ^TMP($J,"IVMLDEM9",IVMLN)=""
. D LNPLUS
. S ^TMP($J,"IVMLDEM9",IVMLN)="*** NO RECORDS TO PRINT ***"
S XMTEXT="^TMP($J,""IVMLDEM9"","
D ^XMD
Q
QUE ;Que the task if user invokes option
N ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK,ZUSR,POP,X,ERR,IOP
W !
S ZTIO=""
S ZTRTN="PRINT^IVMLDEM9"
S ZTDESC="IVM AUTO ADDRESS UPLOAD RPT"
D ^%ZTLOAD
D ^%ZISC,HOME^%ZIS
W !,$S($D(ZTSK):"REQUEST QUEUED AS TASK#"_ZTSK,1:"REQUEST CANCELLED!")
Q
TOTAL ;Display record total on the report
N IVMTOTAL
S IVMTOTAL=$G(^TMP($J,"IVMLDEM9","TOTAL"))
D
. D LNPLUS
. S ^TMP($J,"IVMLDEM9",IVMLN)=""
. D LNPLUS
. S ^TMP($J,"IVMLDEM9",IVMLN)="TOTAL RECORD(S): "_$G(IVMTOTAL)
Q
LNPLUS ;Increase line number for the email text
S IVMLN=$G(IVMLN)+1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIVMLDEM9 8733 printed Dec 13, 2024@02:01:50 Page 2
IVMLDEM9 ;ALB/BRM/PHH/LBD/JAM - IVM ADDRESS UPDATES PENDING REVIEW RPT ;4/18/12 4:43pm
+1 ;;2.0;INCOME VERIFICATION MATCH;**79,93,119,126,133,152,177**;21-OCT-94;Build 3
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
EN2 ;entry point for IVM ADDR UPDT PENDING REVIEW menu option
+1 KILL ^TMP("IVMLDEM9",$JOB)
+2 KILL ^TMP($JOB,"IVMLDEM9")
+3 ;If mail group has no member or remote-member
+4 IF '$$MEMBER()
Begin DoDot:1
+5 IF '$DATA(ZTQUEUED)
WRITE !!,"IVM ADDR UPDT REPORT does not have a member. Report not sent."
KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
End DoDot:1
QUIT
+6 ;started by Taskman job
IF +$GET(ZTSK)
DO PRINT
DO EXIT
QUIT
+7 ;User runs the option
+8 IF '$DATA(ZTQUEUED)
Begin DoDot:1
+9 WRITE !!,"The report will be sent to mail group IVM ADDR UPDT REPORT"
+10 DO QUE
+11 DO EXIT
+12 KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
End DoDot:1
+13 QUIT
+14 ;
LOOP(DTPARAM,FILDAT) ;main loop
+1 NEW DFN,IVMDT,IVMDA,IVMDA1,IVMDA2,RF171,TODAY,AUTODT,DTDIFF,NAME,UPLDT
+2 NEW X1,X2,Y,SSN,DFN
+3 DO DT^DILF("X","T"_$GET(DTPARAM),.AUTODT)
+4 SET TODAY=$$DT^XLFDT
if '$GET(FILDAT)
SET FILDAT=0
+5 ;this should never occur, but just in case
if '$GET(AUTODT)
QUIT
+6 SET RF171=$ORDER(^IVM(301.92,"C","RF171",""))
SET IVMDA2=""
+7 if 'RF171
QUIT
+8 FOR
SET IVMDA2=$ORDER(^IVM(301.5,IVMDA2))
if IVMDA2=""
QUIT
Begin DoDot:1
+9 SET DFN=$PIECE($GET(^IVM(301.5,IVMDA2,0)),"^")
SET IVMDA1=""
+10 if ('DFN)!('$DATA(^DPT(+DFN)))!('$DATA(^IVM(301.5,IVMDA2,"IN")))
QUIT
+11 FOR
SET IVMDA1=$ORDER(^IVM(301.5,IVMDA2,"IN",IVMDA1))
if IVMDA1=""
QUIT
Begin DoDot:2
+12 if '$DATA(^IVM(301.5,IVMDA2,"IN",IVMDA1,"DEM","B",RF171))
QUIT
+13 SET IVMDA=""
+14 FOR
SET IVMDA=$ORDER(^IVM(301.5,IVMDA2,"IN",IVMDA1,"DEM","B",RF171,IVMDA))
if 'IVMDA
QUIT
Begin DoDot:3
+15 SET IVMDT=$PIECE($GET(^IVM(301.5,IVMDA2,"IN",IVMDA1,"DEM",IVMDA,0)),"^",3)
+16 if ('IVMDT)!(IVMDT>AUTODT)
QUIT
+17 ; report addresses that will be auto-uploaded in DTDIFF days
+18 SET X1=TODAY
SET X2=IVMDT
DO ^%DTC
SET DTDIFF=+$GET(X)
+19 SET NAME=$PIECE($GET(^DPT(DFN,0)),"^")
SET SSN=$PIECE($GET(^DPT(DFN,0)),"^",9)
+20 SET X1=IVMDT
SET X2=14
DO C^%DTC
SET UPLDT=$GET(X)
+21 IF '$DATA(^IVM(301.5,"ASEG","PID",IVMDA2))
QUIT
+22 SET ^TMP("IVMLDEM9",$JOB,DTDIFF,SSN,IVMDA)=$GET(NAME)_"^"_$PIECE(IVMDT,".")_"^"_$PIECE(UPLDT,".")_"^"_DFN_"^"_IVMDA2_"^"_IVMDA1
End DoDot:3
End DoDot:2
End DoDot:1
+23 QUIT
+24 ;
AUTOLOAD(DFN,IVMDA2,IVMDA1) ;auto-upload records that not been reviewed
+1 ; this tag is called from ^IVMLDEMC
+2 ;
+3 if ('$GET(DFN))!('$GET(IVMDA2))!('$GET(IVMDA1))
QUIT
+4 NEW IVMI,IVMJ,IVMFIELD,IVMVALUE,IVMNODE,IVMFLAG,DUZ
+5 SET DUZ=.5
+6 ;
+7 ; determine appropriate address change dt/tm to be used
+8 DO ADDRDT^IVMLDEM6(DFN,IVMDA2,IVMDA1)
+9 ;
+10 NEW DGPRIOR
DO GETPRIOR^DGADDUTL(DFN,.DGPRIOR)
+11 ;
+12 ; loop through the record to be uploaded
+13 SET IVMI=0
FOR
SET IVMI=$ORDER(^IVM(301.92,"AD",IVMI))
if IVMI']""
QUIT
Begin DoDot:1
+14 SET IVMJ=0
FOR
SET IVMJ=$ORDER(^IVM(301.5,IVMDA2,"IN",IVMDA1,"DEM","B",IVMI,IVMJ))
if IVMJ']""
QUIT
Begin DoDot:2
+15 ;
+16 ; check for data node in (#301.511) sub-file
+17 SET IVMNODE=$GET(^IVM(301.5,IVMDA2,"IN",IVMDA1,"DEM",IVMJ,0))
+18 if ('+IVMNODE)!($PIECE(IVMNODE,"^",2)']"")
QUIT
+19 ;
+20 ; check for residence phone number -> do not auto-upload
+21 if (+IVMNODE=$ORDER(^IVM(301.92,"B","PHONE NUMBER [RESIDENCE]",0)))
QUIT
+22 ;
+23 ; IVM*2.0*177 ; jam; Comment lines below to skip over reject/upload logic for these records and just do cleanup
+24 ;
+25 ; do not auto-upload if there is an active prescription
+26 ;I $$PHARM^IVMLDEM6(+DFN) D REJTADD Q
+27 ;
+28 ; set upload parameters
+29 ;S IVMFIELD=$P($G(^IVM(301.92,+IVMNODE,0)),"^",5)
+30 ;S IVMVALUE=$P(IVMNODE,"^",2)
+31 ;
+32 ; load addr field into the Patient (#2) file
+33 ;D UPLOAD^IVMLDEM6(DFN,IVMFIELD,IVMVALUE) S IVMFLAG=1
+34 ;
+35 ; remove entry from (#301.511) sub-file
+36 DO DELENT^IVMLDEMU(IVMDA2,IVMDA1,IVMJ)
+37 ;
+38 ; if no display or uploadable fields, delete PID segment
+39 IF ('$$DEMO^IVMLDEM5(IVMDA2,IVMDA1,0))&('$$DEMO^IVMLDEM5(IVMDA2,IVMDA1,1))
DO DELETE^IVMLDEM5(IVMDA2,IVMDA1," ")
End DoDot:2
End DoDot:1
+40 ;
+41 IF +$GET(IVMFLAG)
Begin DoDot:1
+42 NEW DGCURR
+43 DO GETUPDTS^DGADDUTL(DFN,.DGCURR)
+44 DO UPDADDLG^DGADDUTL(DFN,.DGPRIOR,.DGCURR)
End DoDot:1
+45 QUIT
REJTADD ;Reject the address
+1 ;
+2 ; update the ADDRESS CHANGE DT/TM field #.118 in PATIENT file #2
+3 DO UPDDTTM^DGADDUTL(DFN,"PERM")
+4 ;
+5 ; trigger the record to transmit the existing address on file to HEC
+6 ; Used in SETSTAT^IVMPLOG to prevent filing.
NEW DGENUPLD
+7 NEW DA,X,IVMX
+8 SET (DA,X)=DFN
+9 SET IVMX=X
SET X="IVMPXFR"
XECUTE ^%ZOSF("TEST")
if $TEST
DO DPT^IVMPXFR
SET X=IVMX
+10 QUIT
PRINT ;report output
+1 NEW DAYS,SSN,DATA,EX,PAGE,IVMDA,DATA,IVMLN,XMY,XMSUB,XMDUZ,XMTEXT
+2 DO LOOP("",0)
+3 DO HDR
+4 DO DISPLAY
+5 DO EMAIL
+6 QUIT
DISPLAY ;Display the report
+1 SET DAYS=""
+2 IF '$DATA(^TMP("IVMLDEM9",$JOB))
QUIT
+3 FOR
SET DAYS=$ORDER(^TMP("IVMLDEM9",$JOB,DAYS),-1)
if DAYS=""!($GET(EX))
QUIT
Begin DoDot:1
+4 SET SSN=""
+5 FOR
SET SSN=$ORDER(^TMP("IVMLDEM9",$JOB,DAYS,SSN))
if SSN=""!($GET(EX))
QUIT
Begin DoDot:2
+6 SET IVMDA=""
+7 FOR
SET IVMDA=$ORDER(^TMP("IVMLDEM9",$JOB,DAYS,SSN,IVMDA))
if (IVMDA="")!($GET(EX))
QUIT
Begin DoDot:3
+8 SET DATA=$GET(^TMP("IVMLDEM9",$JOB,DAYS,SSN,IVMDA))
+9 DO LNPLUS
+10 SET ^TMP($JOB,"IVMLDEM9",IVMLN)=" "_$$FMTE^XLFDT($PIECE(DATA,"^",3))_" "_$$FMTE^XLFDT($PIECE(DATA,"^",2))_" "_SSN_" "_$PIECE(DATA,"^")
+11 SET ^TMP($JOB,"IVMLDEM9","TOTAL")=$GET(^TMP($JOB,"IVMLDEM9","TOTAL"))+1
End DoDot:3
End DoDot:2
End DoDot:1
+12 DO TOTAL
+13 Begin DoDot:1
+14 DO LNPLUS
+15 SET ^TMP($JOB,"IVMLDEM9",IVMLN)=""
+16 DO LNPLUS
+17 SET ^TMP($JOB,"IVMLDEM9",IVMLN)=" <<END OF REPORT>>"
End DoDot:1
+18 IF $EXTRACT(IOST)="C"
WRITE !
KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
+19 QUIT
HDR ;print header
+1 NEW IVMDT,Y,DLINE
+2 IF $DATA(ZTQUEUED)
IF $$S^%ZTLOAD
SET (ZTSTOP,EX)=1
QUIT
+3 SET Y=DT
XECUTE ^DD("DD")
SET IVMDT=Y
+4 Begin DoDot:1
+5 DO LNPLUS
+6 SET ^TMP($JOB,"IVMLDEM9",IVMLN)=""
+7 DO LNPLUS
+8 SET ^TMP($JOB,"IVMLDEM9",IVMLN)=" IVM ADDRESS UPDATES PENDING REVIEW "_IVMDT
+9 DO LNPLUS
+10 SET $PIECE(^TMP($JOB,"IVMLDEM9",IVMLN),"=",78)=""
+11 DO LNPLUS
+12 SET ^TMP($JOB,"IVMLDEM9",IVMLN)=""
+13 DO LNPLUS
+14 SET ^TMP($JOB,"IVMLDEM9",IVMLN)=" Auto-Upload Date Date Received SSN Patient Name"
+15 DO LNPLUS
+16 SET ^TMP($JOB,"IVMLDEM9",IVMLN)=" ---------------- ------------- --------- ------------"
End DoDot:1
+17 QUIT
EXIT DO ^%ZISC
DO HOME^%ZIS
QUIT
+1 KILL ^TMP($JOB,"IVMLDEM9")
+2 KILL ^TMP("IVMLDEM9",$JOB)
+3 ;
ADRDTCK(DFN,IVMDA2,IVMDA1) ;is the incoming address older than #2 address?
+1 if '$GET(DFN)!('$GET(IVMDA2))!('$GET(IVMDA1))
QUIT "0^MISSING INPUT PARAMETER"
+2 NEW OADDRDT,NADDRDT,ERR,IVMDA,IEN92,IENS
+3 SET OADDRDT=$$GET1^DIQ(2,DFN_",",.118,"I","","ERR")
if $DATA(ERR)
QUIT "0^OLD ADDR ERROR"
+4 SET IEN92=$ORDER(^IVM(301.92,"C","RF171",""))
if 'IEN92
QUIT "0^BAD #301.92 ENTRY FOR RF171"
+5 IF '$DATA(^IVM(301.5,IVMDA2,"IN",IVMDA1,"DEM","B",IEN92))
QUIT "0^ADDR DT NOT PRESENT"
+6 SET IVMDA=$ORDER(^IVM(301.5,IVMDA2,"IN",IVMDA1,"DEM","B",IEN92,""))
if 'IVMDA
QUIT "0^MISSING ADDR DT IN 301.5"
+7 SET IENS=IVMDA_","_IVMDA1_","_IVMDA2_","
+8 SET NADDRDT=$$GET1^DIQ(301.511,IENS,.02,"I","","ERR")
if $DATA(ERR)
QUIT "0^NEW ADDR ERROR"
+9 if (OADDRDT="")&(NADDRDT="")
QUIT 0
+10 if (NADDRDT="")!(OADDRDT'<NADDRDT)
QUIT 1
+11 QUIT "0^INCOMING ADDRESS IS NEWER THAN PATIENT FILE ADDR"
+12 ;
PHNDTCK(DFN,IVMDA2,IVMDA1) ;is the incoming phone # older than #2 phone #?
+1 if '$GET(DFN)!('$GET(IVMDA2))!('$GET(IVMDA1))
QUIT "0^MISSING INPUT PARAMETER"
+2 NEW OPHNDT,NPHNDT,ERR,IVMDA,IEN92,IENS
+3 SET OPHNDT=$$GET1^DIQ(2,DFN_",",.1321,"I","","ERR")
if $DATA(ERR)
QUIT "0^OLD PHN ERROR"
+4 SET IEN92=$ORDER(^IVM(301.92,"C","RF171P",""))
if 'IEN92
QUIT "0^BAD #301.92 ENTRY FOR RF171P"
+5 IF '$DATA(^IVM(301.5,IVMDA2,"IN",IVMDA1,"DEM","B",IEN92))
QUIT "0^PHN DT NOT PRESENT"
+6 SET IVMDA=$ORDER(^IVM(301.5,IVMDA2,"IN",IVMDA1,"DEM","B",IEN92,""))
if 'IVMDA
QUIT "0^MISSING PHN DT IN 301.5"
+7 SET IENS=IVMDA_","_IVMDA1_","_IVMDA2_","
+8 SET NPHNDT=$$GET1^DIQ(301.511,IENS,.02,"I","","ERR")
if $DATA(ERR)
QUIT "0^NEW PHN ERROR"
+9 if (OPHNDT="")&(NPHNDT="")
QUIT 0
+10 if (NPHNDT="")!(OPHNDT'<NPHNDT)
QUIT 1
+11 QUIT "0^INCOMING PHONE # IS NEWER THAN PATIENT FILE PHONE #"
+12 ;
MEMBER() ;Return 0 if mail group has no local or remote member
+1 NEW RESULT,IVMIEN,IVMRMT
+2 SET RESULT=1
+3 SET IVMIEN=$$FIND1^DIC(3.8,"","X","IVM ADDR UPDT REPORT")
+4 DO LIST^DIC(3.812,","_IVMIEN_",",.01,"P","","","","","","","IVMRMT")
+5 IF ($PIECE($GET(IVMRMT("DILIST",0)),U)'>0)
IF ('$$GOTLOCAL^XMXAPIG("IVM ADDR UPDT REPORT"))
SET RESULT=0
+6 QUIT RESULT
EMAIL ;Set up parameters to email the report
+1 ;If called within a task, protect variables
+2 IF $DATA(ZTQUEUED)
NEW %,DIFROM
+3 NEW RDT
+4 DO NOW^%DTC
SET Y=%
XECUTE ^DD("DD")
+5 SET RDT=$PIECE(Y,"@",1)_"@"_$PIECE($PIECE(Y,"@",2),":",1,2)
+6 SET XMSUB="IVM Address Pending Review ("_RDT_")"
+7 SET XMY("G.IVM ADDR UPDT REPORT")=""
+8 IF $GET(^TMP($JOB,"IVMLDEM9","TOTAL"))<1
Begin DoDot:1
+9 DO LNPLUS
+10 SET ^TMP($JOB,"IVMLDEM9",IVMLN)=""
+11 DO LNPLUS
+12 SET ^TMP($JOB,"IVMLDEM9",IVMLN)="*** NO RECORDS TO PRINT ***"
End DoDot:1
+13 SET XMTEXT="^TMP($J,""IVMLDEM9"","
+14 DO ^XMD
+15 QUIT
QUE ;Que the task if user invokes option
+1 NEW ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK,ZUSR,POP,X,ERR,IOP
+2 WRITE !
+3 SET ZTIO=""
+4 SET ZTRTN="PRINT^IVMLDEM9"
+5 SET ZTDESC="IVM AUTO ADDRESS UPLOAD RPT"
+6 DO ^%ZTLOAD
+7 DO ^%ZISC
DO HOME^%ZIS
+8 WRITE !,$SELECT($DATA(ZTSK):"REQUEST QUEUED AS TASK#"_ZTSK,1:"REQUEST CANCELLED!")
+9 QUIT
TOTAL ;Display record total on the report
+1 NEW IVMTOTAL
+2 SET IVMTOTAL=$GET(^TMP($JOB,"IVMLDEM9","TOTAL"))
+3 Begin DoDot:1
+4 DO LNPLUS
+5 SET ^TMP($JOB,"IVMLDEM9",IVMLN)=""
+6 DO LNPLUS
+7 SET ^TMP($JOB,"IVMLDEM9",IVMLN)="TOTAL RECORD(S): "_$GET(IVMTOTAL)
End DoDot:1
+8 QUIT
LNPLUS ;Increase line number for the email text
+1 SET IVMLN=$GET(IVMLN)+1
+2 QUIT
