[613] | 1 | IVMADDRP ;ALB/PHH,EG - IVM ADDRESS UPLOAD LOG REPORT ; 03/29/2006
|
---|
| 2 | ;;2.0;INCOME VERIFICATION MATCH;**108,106**; 21-OCT-94
|
---|
| 3 | ;
|
---|
| 4 | ; This routine list veterans who have had more than one address
|
---|
| 5 | ; change in the past 90 days.
|
---|
| 6 | ;
|
---|
| 7 | N SDATE,EDATE,HDR,MSG,%ZIS,ZTRTN,ZTDESC,ZTSAVE,PAGE,ZTSK,ZTREQ,POP,X
|
---|
| 8 | N BDT,U,DFN,SO
|
---|
| 9 | S U="^",DFN="",SO=""
|
---|
| 10 | S DOS=$$DOS
|
---|
| 11 | I DOS="^" Q
|
---|
| 12 | S X=$$ENDDATE
|
---|
| 13 | I X="" Q
|
---|
| 14 | S BDT=$P(X,"^",1)
|
---|
| 15 | I DOS="D" D I DFN="" Q
|
---|
| 16 | . S DFN=$$GETPAT
|
---|
| 17 | . Q
|
---|
| 18 | I DOS="S" S SO=$$SORTORD I SO="^" Q
|
---|
| 19 | S (SDATE,EDATE,HDR)=""
|
---|
| 20 | S EDATE=$$FMADD^XLFDT(BDT) I EDATE="" Q
|
---|
| 21 | S SDATE=$$FMADD^XLFDT(EDATE,-90)
|
---|
| 22 | ;
|
---|
| 23 | ; Get report device. Queue report if requested
|
---|
| 24 | S MSG(1)=""
|
---|
| 25 | S MSG(2)="This report may take a long time to generate. It is recommended that the report"
|
---|
| 26 | S MSG(3)="be queued to print."
|
---|
| 27 | S MSG(4)=""
|
---|
| 28 | D BMES^XPDUTL(.MSG)
|
---|
| 29 | K IOP,%ZIS
|
---|
| 30 | S %ZIS="MQ"
|
---|
| 31 | D ^%ZIS I POP W !!,"Report Cancelled!" Q
|
---|
| 32 | I $D(IO("Q")) D Q
|
---|
| 33 | . S ZTRTN="START^IVMADDRP"
|
---|
| 34 | . S ZTDESC="IVM Address Change Log Report"
|
---|
| 35 | . S (ZTSAVE("PAGE"),ZTSAVE("SDATE"),ZTSAVE("EDATE"))=""
|
---|
| 36 | . S (ZTSAVE("DOS"),ZTSAVE("DFN"),ZTSAVE("SO"))=""
|
---|
| 37 | . D ^%ZTLOAD
|
---|
| 38 | . W !!,"Report "_$S($D(ZTSK):"Queued!",1:"Cancelled!")
|
---|
| 39 | . D HOME^%ZIS
|
---|
| 40 | . Q
|
---|
| 41 | D START,^%ZISC
|
---|
| 42 | Q
|
---|
| 43 | DOS() ;detail or summary
|
---|
| 44 | N DIR,Y,X
|
---|
| 45 | S DIR(0)="SA^D:Detail;S:Summary"
|
---|
| 46 | S DIR("A")="Select Type of Report to Run: "
|
---|
| 47 | D ^DIR
|
---|
| 48 | Q Y
|
---|
| 49 | ;
|
---|
| 50 | GETPAT() ;get a patient
|
---|
| 51 | N DIC,Y,X,U
|
---|
| 52 | S DIC="^DPT(",DIC(0)="AEQZM" D ^DIC
|
---|
| 53 | Q $S($P(Y,U,1)>0:$P(Y,U,1),1:"")
|
---|
| 54 | ;
|
---|
| 55 | ENDDATE() ;get an end date, default to TODAY
|
---|
| 56 | N DIR,Y,X
|
---|
| 57 | S DIR(0)="D^::EX",DIR("?")="^D HELP^%DTC",DIR("B")=$$FMTE^XLFDT(DT)
|
---|
| 58 | S DIR("A")="Enter End Date of 90 Day Window: "
|
---|
| 59 | D ^DIR
|
---|
| 60 | Q $S('Y:"",1:Y)
|
---|
| 61 | ;
|
---|
| 62 | SORTORD() ;get sort order for summary
|
---|
| 63 | N DIR,Y,X
|
---|
| 64 | S DIR(0)="SA^S:Social Security Number;N:Name then SSN"
|
---|
| 65 | S DIR("A")="What Order Do You Want to See Output: "
|
---|
| 66 | D ^DIR
|
---|
| 67 | Q Y
|
---|
| 68 | ;
|
---|
| 69 | START ; Generate Report
|
---|
| 70 | N CRT,X
|
---|
| 71 | K ^XTMP("IVMADDRP",$J)
|
---|
| 72 | S CRT=$S($E(IOST,1,2)="C-":1,1:0)
|
---|
| 73 | S X=$$BUILD(SDATE,EDATE,DOS,DFN,SO)
|
---|
| 74 | U IO W ! D REPORT W ! U 0
|
---|
| 75 | K ^XTMP("IVMADDRP",$J)
|
---|
| 76 | I $G(ZTSK) S ZTREQ="@"
|
---|
| 77 | Q
|
---|
| 78 | BUILD(SDATE,EDATE,DOS,DFN,SO) ; Build the Report
|
---|
| 79 | ;use C index if you are only looking for one DFN
|
---|
| 80 | I $L(DFN) D C Q 1
|
---|
| 81 | N CHDTTM
|
---|
| 82 | S CHDTTM=SDATE
|
---|
| 83 | F S CHDTTM=$O(^IVM(301.7,"B",CHDTTM)) Q:CHDTTM=""!(CHDTTM>(EDATE+1)) D ADDIEN
|
---|
| 84 | Q 1
|
---|
| 85 | ADDIEN ;
|
---|
| 86 | N ADDIEN
|
---|
| 87 | S ADDIEN=0
|
---|
| 88 | F S ADDIEN=$O(^IVM(301.7,"B",CHDTTM,ADDIEN)) Q:ADDIEN="" D GETINF
|
---|
| 89 | Q
|
---|
| 90 | C N ADDIEN,CHDTTM
|
---|
| 91 | S ADDIEN=""
|
---|
| 92 | F S ADDIEN=$O(^IVM(301.7,"C",DFN,ADDIEN)) Q:ADDIEN="" D
|
---|
| 93 | . S CHDTTM=$P($G(^IVM(301.7,ADDIEN,0)),"^",1)
|
---|
| 94 | . I (CHDTTM>SDATE),(CHDTTM<(EDATE+1)) D GETINF
|
---|
| 95 | . Q
|
---|
| 96 | Q
|
---|
| 97 | GETINF ;
|
---|
| 98 | N NODE0,NODE1,DFN,SSN,NAME,ADDR1,ADDR2,CITY,STATE,ZIP,SORT1,SORT2,U,SOURCE,SIEN,SITE
|
---|
| 99 | S U="^",SITE=""
|
---|
| 100 | S NODE0=$G(^IVM(301.7,ADDIEN,0))
|
---|
| 101 | S NODE1=$G(^IVM(301.7,ADDIEN,1))
|
---|
| 102 | S DFN=$P(NODE0,"^",2)
|
---|
| 103 | Q:DFN=""
|
---|
| 104 | Q:'$D(^DPT(DFN))
|
---|
| 105 | S SSN=$P($G(^DPT(DFN,0)),"^",9)
|
---|
| 106 | Q:SSN=""
|
---|
| 107 | S NAME=$P($G(^DPT(DFN,0)),"^",1)
|
---|
| 108 | S SOURCE=$P(NODE1,"^",4),SIEN=$P(NODE1,"^",3)
|
---|
| 109 | I SIEN S SITE=$P($G(^DIC(4,SIEN,0)),"^",1)
|
---|
| 110 | S ADDR1=$P(NODE1,"^",6)
|
---|
| 111 | S ADDR2=$P(NODE1,"^",7)
|
---|
| 112 | S CITY=$P(NODE1,"^",8)
|
---|
| 113 | S STATE=$P(NODE1,"^",10)
|
---|
| 114 | I STATE'="",$D(^DIC(5,STATE,0)) S STATE=$P(^DIC(5,STATE,0),"^",2)
|
---|
| 115 | S ZIP=$P(NODE1,"^",11)
|
---|
| 116 | I DOS="D" D Q
|
---|
| 117 | . S ^XTMP("IVMADDRP",$J,SSN,CHDTTM)=ADDIEN_"^"_DFN_"^"_NAME_"^"_ADDR1_"^"_ADDR2_"^"_CITY_"^"_STATE_"^"_ZIP_"^"_SOURCE_"^"_SITE
|
---|
| 118 | . S ^XTMP("IVMADDRP",$J,SSN)=$G(^XTMP("IVMADDRP",$J,SSN))+1
|
---|
| 119 | . Q
|
---|
| 120 | I DOS="S" D
|
---|
| 121 | . S SORT1=$S(SO="S":SSN,1:NAME) I NAME="" S SORT1="UNKNOWN"
|
---|
| 122 | . S SORT2=$S(SO="S":0,1:SSN)
|
---|
| 123 | . S ^XTMP("IVMADDRP",$J,SORT1,SORT2,"INF")=NAME_U_SSN
|
---|
| 124 | . S ^XTMP("IVMADDRP",$J,SORT1,SORT2,"DATE",CHDTTM)=""
|
---|
| 125 | . S ^XTMP("IVMADDRP",$J,SORT1,SORT2)=$G(^XTMP("IVMADDRP",$J,SORT1,SORT2))+1
|
---|
| 126 | . Q
|
---|
| 127 | Q
|
---|
| 128 | REPORT ; Display the Report
|
---|
| 129 | D HEADER
|
---|
| 130 | I '$D(^XTMP("IVMADDRP",$J)) D Q
|
---|
| 131 | . N X S X="****** NOTHING TO REPORT ******" W !?80-$L(X)\2,X,!
|
---|
| 132 | . Q
|
---|
| 133 | I DOS="S" D SUMMARY Q
|
---|
| 134 | N SSN
|
---|
| 135 | ;
|
---|
| 136 | S SSN=""
|
---|
| 137 | F S SSN=$O(^XTMP("IVMADDRP",$J,SSN)) Q:SSN="" D DETAIL
|
---|
| 138 | Q
|
---|
| 139 | DETAIL N NAME,CHDTTM,ADDR,ADDR2,CITY,STATE,ZIP,CSZ
|
---|
| 140 | N ADDR1,ADDR2,X,U,QUIT,CNT,SITE,SOURCE
|
---|
| 141 | S CHDTTM="",U="^",QUIT=0,CNT=0
|
---|
| 142 | I $G(^XTMP("IVMADDRP",$J,SSN))'>1 Q
|
---|
| 143 | F S CHDTTM=$O(^XTMP("IVMADDRP",$J,SSN,CHDTTM)) Q:CHDTTM=""!(QUIT) D
|
---|
| 144 | . S X=$G(^XTMP("IVMADDRP",$J,SSN,CHDTTM))
|
---|
| 145 | . S NAME=$P(X,U,3)
|
---|
| 146 | . S ADDR1=$P(X,U,4)
|
---|
| 147 | . S ADDR2=$P(X,U,5)
|
---|
| 148 | . S CITY=$P(X,U,6)
|
---|
| 149 | . S STATE=$P(X,U,7)
|
---|
| 150 | . S ZIP=$P(X,U,8)
|
---|
| 151 | . S SOURCE=$P(X,U,9)
|
---|
| 152 | . S SITE=$P(X,U,10)
|
---|
| 153 | . I ($Y+6)>IOSL D HEADER I QUIT Q
|
---|
| 154 | . W !,$$FSSN(SSN),?12,$E(NAME,1,20)
|
---|
| 155 | . W ?35,$$FMTE^XLFDT($P(CHDTTM,".",1))
|
---|
| 156 | . S CSZ=$$CSZ(CITY,STATE,ZIP)
|
---|
| 157 | . W ?49,$E(ADDR1,1,30),!
|
---|
| 158 | . I $L(ADDR2) W ?49,$E(ADDR2,1,30),!
|
---|
| 159 | . I $L(CSZ) W ?49,$E(CSZ,1,30),!
|
---|
| 160 | . I $L(SOURCE) W ?49,"SOURCE: ",SOURCE,!
|
---|
| 161 | . I $L(SITE) W ?49,"SITE: ",SITE
|
---|
| 162 | . S CNT=CNT+1
|
---|
| 163 | . Q
|
---|
| 164 | I 'QUIT D TOTAL(CNT)
|
---|
| 165 | Q
|
---|
| 166 | SUMMARY N SORT1,QUIT,CNT
|
---|
| 167 | S SORT1="",QUIT=0,CNT=0
|
---|
| 168 | F S SORT1=$O(^XTMP("IVMADDRP",$J,SORT1)) Q:SORT1=""!(QUIT) D SORT2
|
---|
| 169 | I 'QUIT D TOTAL(CNT)
|
---|
| 170 | Q
|
---|
| 171 | SORT2 N NAME,SSN
|
---|
| 172 | S SORT2=""
|
---|
| 173 | F S SORT2=$O(^XTMP("IVMADDRP",$J,SORT1,SORT2)) Q:SORT2=""!(QUIT) D
|
---|
| 174 | . I $G(^XTMP("IVMADDRP",$J,SORT1,SORT2))'>1 Q
|
---|
| 175 | . D SUMPR S CNT=CNT+1
|
---|
| 176 | . Q
|
---|
| 177 | Q
|
---|
| 178 | SUMPR N X,U
|
---|
| 179 | S U="^"
|
---|
| 180 | S X=$G(^XTMP("IVMADDRP",$J,SORT1,SORT2,"INF"))
|
---|
| 181 | S NAME=$P(X,U,1),SSN=$P(X,U,2)
|
---|
| 182 | I ($Y+2)>IOSL D HEADER I QUIT Q
|
---|
| 183 | W !,$$FSSN(SSN),?12,$E(NAME,1,20)
|
---|
| 184 | W ?35,$$FMTE^XLFDT($O(^XTMP("IVMADDRP",$J,SORT1,SORT2,"DATE",""),-1))
|
---|
| 185 | S X=$G(^XTMP("IVMADDRP",$J,SORT1,SORT2))
|
---|
| 186 | W ?73,$J($FN(X,","),5)
|
---|
| 187 | Q
|
---|
| 188 | TOTAL(CNT) ;
|
---|
| 189 | I ($Y+2)>IOSL D HEADER
|
---|
| 190 | W !!,"Total records found meeting criteria: ",CNT,!
|
---|
| 191 | Q
|
---|
| 192 | CSZ(CITY,STATE,ZIP) ;format city, state and zip into one line
|
---|
| 193 | N X
|
---|
| 194 | S X=""
|
---|
| 195 | I $L(CITY) S X=CITY
|
---|
| 196 | I $L(STATE) D
|
---|
| 197 | . I $L(X) S X=X_", "_STATE Q
|
---|
| 198 | . S X=STATE
|
---|
| 199 | . Q
|
---|
| 200 | I $L(ZIP) D
|
---|
| 201 | . I $L(X) S X=X_" "_ZIP Q
|
---|
| 202 | . S X=ZIP
|
---|
| 203 | . Q
|
---|
| 204 | Q X
|
---|
| 205 | FSSN(SSN) ; Format the SSN
|
---|
| 206 | N FMTSSN
|
---|
| 207 | I SSN="NO SSN" Q SSN
|
---|
| 208 | I $L(SSN)=9 S FMTSSN=SSN
|
---|
| 209 | I $L(SSN)>9 S FMTSSN=$E(SSN,1,10) ; Account for pseudo-SSN
|
---|
| 210 | I $L(SSN)<9 D
|
---|
| 211 | . S FMTSSN=""
|
---|
| 212 | . F FMTSSN=$L(SSN):1:9 S FMTSSN=FMTSSN_"0"
|
---|
| 213 | . S FMTSSN=FMTSSN_SSN
|
---|
| 214 | . Q
|
---|
| 215 | Q FMTSSN
|
---|
| 216 | HEADER ; Print the header
|
---|
| 217 | N IDX,PGHDR
|
---|
| 218 | S QUIT=0
|
---|
| 219 | I $G(CRT),($G(PAGE)>0) I $$PAUSE(0) S QUIT=1 Q
|
---|
| 220 | S PAGE=$G(PAGE,0),PAGE=PAGE+1,PGHDR="Page: "_$J(PAGE,3)
|
---|
| 221 | W #
|
---|
| 222 | I $G(CRT) W $C(27,91,72,27,91,74) ; Additional $C to clear screen in Cache'
|
---|
| 223 | S IDX="",IDX=$O(HDR(IDX))
|
---|
| 224 | W "IVM ADDRESS CHANGE LOG REPORT",?71,PGHDR
|
---|
| 225 | W !,$$FMTE^XLFDT(SDATE)_" THRU "_$$FMTE^XLFDT(EDATE)
|
---|
| 226 | I DOS="D" D
|
---|
| 227 | . W !!,"SSN",?12,"NAME",?35,"CHANGE DATE",?49,"PRIOR ADDRESS"
|
---|
| 228 | . W !,"---",?12,"----",?35,"-----------",?49,"--------------"
|
---|
| 229 | . Q
|
---|
| 230 | I DOS="S" D
|
---|
| 231 | . W !!,"SSN",?12,"NAME",?35,"LAST UPDATED",?69,"# ENTRIES"
|
---|
| 232 | . W !,"---",?12,"----",?35,"------------",?69,"---------"
|
---|
| 233 | . Q
|
---|
| 234 | Q
|
---|
| 235 | PAUSE(RESP) ; Prompt user for next page or quit
|
---|
| 236 | N DIR,DIRUT,DUOUT,DTOUT,U,X,Y
|
---|
| 237 | W !
|
---|
| 238 | S DIR(0)="E"
|
---|
| 239 | D ^DIR
|
---|
| 240 | I 'Y S RESP=1
|
---|
| 241 | Q RESP
|
---|