IVMADDRP ;ALB/PHH,EG - IVM ADDRESS UPLOAD LOG REPORT ; 03/29/2006
 ;;2.0;INCOME VERIFICATION MATCH;**108,106**; 21-OCT-94
 ;
 ; This routine list veterans who have had more than one address
 ; change in the past 90 days.
 ;
 N SDATE,EDATE,HDR,MSG,%ZIS,ZTRTN,ZTDESC,ZTSAVE,PAGE,ZTSK,ZTREQ,POP,X
 N BDT,U,DFN,SO
 S U="^",DFN="",SO=""
 S DOS=$$DOS
 I DOS="^" Q
 S X=$$ENDDATE
 I X="" Q
 S BDT=$P(X,"^",1)
 I DOS="D" D  I DFN="" Q
 . S DFN=$$GETPAT
 . Q
 I DOS="S" S SO=$$SORTORD I SO="^" Q
 S (SDATE,EDATE,HDR)=""
 S EDATE=$$FMADD^XLFDT(BDT) I EDATE="" Q
 S SDATE=$$FMADD^XLFDT(EDATE,-90)
 ;
 ; Get report device. Queue report if requested
 S MSG(1)=""
 S MSG(2)="This report may take a long time to generate.  It is recommended that the report"
 S MSG(3)="be queued to print."
 S MSG(4)=""
 D BMES^XPDUTL(.MSG)
 K IOP,%ZIS
 S %ZIS="MQ"
 D ^%ZIS I POP W !!,"Report Cancelled!" Q
 I $D(IO("Q")) D  Q
 . S ZTRTN="START^IVMADDRP"
 . S ZTDESC="IVM Address Change Log Report"
 . S (ZTSAVE("PAGE"),ZTSAVE("SDATE"),ZTSAVE("EDATE"))=""
 . S (ZTSAVE("DOS"),ZTSAVE("DFN"),ZTSAVE("SO"))=""
 . D ^%ZTLOAD
 . W !!,"Report "_$S($D(ZTSK):"Queued!",1:"Cancelled!")
 . D HOME^%ZIS
 . Q
 D START,^%ZISC
 Q
DOS() ;detail or summary
 N DIR,Y,X
 S DIR(0)="SA^D:Detail;S:Summary"
 S DIR("A")="Select Type of Report to Run: "
 D ^DIR
 Q Y
 ;
GETPAT() ;get a patient
 N DIC,Y,X,U
 S DIC="^DPT(",DIC(0)="AEQZM" D ^DIC
 Q $S($P(Y,U,1)>0:$P(Y,U,1),1:"")
 ;
ENDDATE() ;get an end date, default to TODAY
 N DIR,Y,X
 S DIR(0)="D^::EX",DIR("?")="^D HELP^%DTC",DIR("B")=$$FMTE^XLFDT(DT)
 S DIR("A")="Enter End Date of 90 Day Window: "
 D ^DIR
 Q $S('Y:"",1:Y)
 ;
SORTORD() ;get sort order for summary
 N DIR,Y,X
 S DIR(0)="SA^S:Social Security Number;N:Name then SSN"
 S DIR("A")="What Order Do You Want to See Output: "
 D ^DIR
 Q Y
 ;
START ; Generate Report
 N CRT,X
 K ^XTMP("IVMADDRP",$J)
 S CRT=$S($E(IOST,1,2)="C-":1,1:0)
 S X=$$BUILD(SDATE,EDATE,DOS,DFN,SO)
 U IO W ! D REPORT W ! U 0
 K ^XTMP("IVMADDRP",$J)
 I $G(ZTSK) S ZTREQ="@"
 Q
BUILD(SDATE,EDATE,DOS,DFN,SO) ; Build the Report
 ;use C index if you are only looking for one DFN
 I $L(DFN) D C Q 1
 N CHDTTM
 S CHDTTM=SDATE
 F  S CHDTTM=$O(^IVM(301.7,"B",CHDTTM)) Q:CHDTTM=""!(CHDTTM>(EDATE+1))  D ADDIEN
 Q 1
ADDIEN ;
 N ADDIEN
 S ADDIEN=0
 F  S ADDIEN=$O(^IVM(301.7,"B",CHDTTM,ADDIEN)) Q:ADDIEN=""  D GETINF
 Q
C N ADDIEN,CHDTTM
 S ADDIEN=""
 F  S ADDIEN=$O(^IVM(301.7,"C",DFN,ADDIEN)) Q:ADDIEN=""  D
 . S CHDTTM=$P($G(^IVM(301.7,ADDIEN,0)),"^",1)
 . I (CHDTTM>SDATE),(CHDTTM<(EDATE+1)) D GETINF
 . Q
 Q
GETINF ; 
 N NODE0,NODE1,DFN,SSN,NAME,ADDR1,ADDR2,CITY,STATE,ZIP,SORT1,SORT2,U,SOURCE,SIEN,SITE
 S U="^",SITE=""
 S NODE0=$G(^IVM(301.7,ADDIEN,0))
 S NODE1=$G(^IVM(301.7,ADDIEN,1))
 S DFN=$P(NODE0,"^",2)
 Q:DFN=""
 Q:'$D(^DPT(DFN))
 S SSN=$P($G(^DPT(DFN,0)),"^",9)
 Q:SSN=""
 S NAME=$P($G(^DPT(DFN,0)),"^",1)
 S SOURCE=$P(NODE1,"^",4),SIEN=$P(NODE1,"^",3)
 I SIEN S SITE=$P($G(^DIC(4,SIEN,0)),"^",1)
 S ADDR1=$P(NODE1,"^",6)
 S ADDR2=$P(NODE1,"^",7)
 S CITY=$P(NODE1,"^",8)
 S STATE=$P(NODE1,"^",10)
 I STATE'="",$D(^DIC(5,STATE,0)) S STATE=$P(^DIC(5,STATE,0),"^",2)
 S ZIP=$P(NODE1,"^",11)
 I DOS="D" D  Q
 . S ^XTMP("IVMADDRP",$J,SSN,CHDTTM)=ADDIEN_"^"_DFN_"^"_NAME_"^"_ADDR1_"^"_ADDR2_"^"_CITY_"^"_STATE_"^"_ZIP_"^"_SOURCE_"^"_SITE
 . S ^XTMP("IVMADDRP",$J,SSN)=$G(^XTMP("IVMADDRP",$J,SSN))+1
 . Q
 I DOS="S" D
 . S SORT1=$S(SO="S":SSN,1:NAME) I NAME="" S SORT1="UNKNOWN"
 . S SORT2=$S(SO="S":0,1:SSN)
 . S ^XTMP("IVMADDRP",$J,SORT1,SORT2,"INF")=NAME_U_SSN
 . S ^XTMP("IVMADDRP",$J,SORT1,SORT2,"DATE",CHDTTM)=""
 . S ^XTMP("IVMADDRP",$J,SORT1,SORT2)=$G(^XTMP("IVMADDRP",$J,SORT1,SORT2))+1
 . Q
 Q
REPORT ; Display the Report
 D HEADER
 I '$D(^XTMP("IVMADDRP",$J)) D  Q
 . N X S X="****** NOTHING TO REPORT ******" W !?80-$L(X)\2,X,!
 . Q
 I DOS="S" D SUMMARY Q
 N SSN
 ;
 S SSN=""
 F  S SSN=$O(^XTMP("IVMADDRP",$J,SSN)) Q:SSN=""  D DETAIL
 Q
DETAIL N NAME,CHDTTM,ADDR,ADDR2,CITY,STATE,ZIP,CSZ
 N ADDR1,ADDR2,X,U,QUIT,CNT,SITE,SOURCE
 S CHDTTM="",U="^",QUIT=0,CNT=0
 I $G(^XTMP("IVMADDRP",$J,SSN))'>1 Q
 F  S CHDTTM=$O(^XTMP("IVMADDRP",$J,SSN,CHDTTM)) Q:CHDTTM=""!(QUIT)  D
 . S X=$G(^XTMP("IVMADDRP",$J,SSN,CHDTTM))
 . S NAME=$P(X,U,3)
 . S ADDR1=$P(X,U,4)
 . S ADDR2=$P(X,U,5)
 . S CITY=$P(X,U,6)
 . S STATE=$P(X,U,7)
 . S ZIP=$P(X,U,8)
 . S SOURCE=$P(X,U,9)
 . S SITE=$P(X,U,10)
 . I ($Y+6)>IOSL D HEADER I QUIT Q
 . W !,$$FSSN(SSN),?12,$E(NAME,1,20)
 . W ?35,$$FMTE^XLFDT($P(CHDTTM,".",1))
 . S CSZ=$$CSZ(CITY,STATE,ZIP)
 . W ?49,$E(ADDR1,1,30),!
 . I $L(ADDR2) W ?49,$E(ADDR2,1,30),!
 . I $L(CSZ) W ?49,$E(CSZ,1,30),!
 . I $L(SOURCE) W ?49,"SOURCE: ",SOURCE,!
 . I $L(SITE) W ?49,"SITE: ",SITE
 . S CNT=CNT+1
 . Q
 I 'QUIT D TOTAL(CNT)
 Q
SUMMARY N SORT1,QUIT,CNT
 S SORT1="",QUIT=0,CNT=0
 F  S SORT1=$O(^XTMP("IVMADDRP",$J,SORT1)) Q:SORT1=""!(QUIT)  D SORT2
 I 'QUIT D TOTAL(CNT)
 Q
SORT2 N NAME,SSN
 S SORT2=""
 F  S SORT2=$O(^XTMP("IVMADDRP",$J,SORT1,SORT2)) Q:SORT2=""!(QUIT)  D
 . I $G(^XTMP("IVMADDRP",$J,SORT1,SORT2))'>1 Q
 . D SUMPR S CNT=CNT+1
 . Q
 Q
SUMPR N X,U
 S U="^"
 S X=$G(^XTMP("IVMADDRP",$J,SORT1,SORT2,"INF"))
 S NAME=$P(X,U,1),SSN=$P(X,U,2)
 I ($Y+2)>IOSL D HEADER I QUIT Q
 W !,$$FSSN(SSN),?12,$E(NAME,1,20)
 W ?35,$$FMTE^XLFDT($O(^XTMP("IVMADDRP",$J,SORT1,SORT2,"DATE",""),-1))
 S X=$G(^XTMP("IVMADDRP",$J,SORT1,SORT2))
 W ?73,$J($FN(X,","),5)
 Q
TOTAL(CNT) ;
 I ($Y+2)>IOSL D HEADER
 W !!,"Total records found meeting criteria: ",CNT,!
 Q
CSZ(CITY,STATE,ZIP) ;format city, state and zip into one line
 N X
 S X=""
 I $L(CITY) S X=CITY
 I $L(STATE) D
 . I $L(X) S X=X_", "_STATE Q
 . S X=STATE
 . Q
 I $L(ZIP) D
 . I $L(X) S X=X_"  "_ZIP Q
 . S X=ZIP
 . Q
 Q X
FSSN(SSN) ; Format the SSN
 N FMTSSN
 I SSN="NO SSN" Q SSN
 I $L(SSN)=9 S FMTSSN=SSN
 I $L(SSN)>9 S FMTSSN=$E(SSN,1,10)  ; Account for pseudo-SSN
 I $L(SSN)<9 D
 . S FMTSSN=""
 . F FMTSSN=$L(SSN):1:9 S FMTSSN=FMTSSN_"0"
 . S FMTSSN=FMTSSN_SSN
 . Q
 Q FMTSSN
HEADER ; Print the header
 N IDX,PGHDR
 S QUIT=0
 I $G(CRT),($G(PAGE)>0) I $$PAUSE(0) S QUIT=1 Q
 S PAGE=$G(PAGE,0),PAGE=PAGE+1,PGHDR="Page: "_$J(PAGE,3)
 W #
 I $G(CRT) W $C(27,91,72,27,91,74)  ; Additional $C to clear screen in Cache'
 S IDX="",IDX=$O(HDR(IDX))
 W "IVM ADDRESS CHANGE LOG REPORT",?71,PGHDR
 W !,$$FMTE^XLFDT(SDATE)_" THRU "_$$FMTE^XLFDT(EDATE)
 I DOS="D" D
 . W !!,"SSN",?12,"NAME",?35,"CHANGE DATE",?49,"PRIOR ADDRESS"
 . W !,"---",?12,"----",?35,"-----------",?49,"--------------"
 . Q
 I DOS="S" D
 . W !!,"SSN",?12,"NAME",?35,"LAST UPDATED",?69,"# ENTRIES"
 . W !,"---",?12,"----",?35,"------------",?69,"---------"
 . Q
 Q
PAUSE(RESP) ; Prompt user for next page or quit
 N DIR,DIRUT,DUOUT,DTOUT,U,X,Y
 W !
 S DIR(0)="E"
 D ^DIR
 I 'Y S RESP=1
 Q RESP