Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IVMLDEM9

IVMLDEM9.m

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