- 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 Feb 18, 2025@23:27:25 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