IVMADDRP ;ALB/PHH,EG,ERC,BAJ,CKN - IVM ADDRESS UPLOAD LOG REPORT ; 7/11/06 4:36pm
;;2.0;INCOME VERIFICATION MATCH;**108,106,115**; 21-OCT-94;Build 28
;
; 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
N SOURCE,SIEN,SITE,PROV,PCODE,COUNTRY,DGBAI,BAI,ADDR3,NODE2
S U="^",SITE=""
S NODE0=$G(^IVM(301.7,ADDIEN,0))
S NODE1=$G(^IVM(301.7,ADDIEN,1))
S NODE2=$G(^IVM(301.7,ADDIEN,2))
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 ADDR3=$P(NODE2,"^",1)
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)
S PROV=$P(NODE1,"^",12)
S PCODE=$P(NODE1,"^",13)
S COUNTRY=$P(NODE1,"^",14)
I COUNTRY'="",$D(^HL(779.004,"B",COUNTRY,0)) S COUNTRY=$$CNTRYI^DGADDUTL(COUNTRY)
I COUNTRY=-1 S COUNTRY="UNKNOWN COUNTRY"
S DGBAI=$P(NODE1,"^",15)
S BAI=$S(DGBAI=1:"UNDELIVERABLE",DGBAI=2:"HOMELESS",DGBAI=3:"OTHER",DGBAI=4:"ADDRESS NOT FOUND",1:"")
I DOS="D" D Q
. S ^XTMP("IVMADDRP",$J,SSN,CHDTTM)=ADDIEN_"^"_DFN_"^"_NAME_"^"_ADDR1_"^"_ADDR2_"^"_CITY_"^"_STATE_"^"_ZIP_"^"_SOURCE_"^"_SITE_"^"_PROV_"^"_PCODE_"^"_COUNTRY_"^"_BAI_"^"_ADDR3
. 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,DGCNTRY,DGFOR,ADDR3,BAI
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 ADDR3=$P(X,U,15)
. 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)
. S PROV=$P(X,U,11)
. S PCODE=$P(X,U,12)
. S COUNTRY=$P(X,U,13)
. S BAI=$P(X,U,14)
. S DGCNTRY=$$CNTRYI^DGADDUTL(COUNTRY)
. S DGFOR=$$FORIEN^DGADDUTL(COUNTRY)
. I DGFOR=-1 S DGCNTRY="UNKNOWN COUNTRY" S DGFOR=1
. I ($Y+6)>IOSL D HEADER I QUIT Q
. W !,$$FSSN(SSN),?12,$E(NAME,1,20)
. W ?35,$$FMTE^XLFDT($P(CHDTTM,".",1))
. I DGFOR=0 S CSZ=$$CSZ(CITY,STATE,ZIP)
. I DGFOR=1 S CSZ=$$PCP(PCODE,CITY,PROV)
. W ?49,$E(ADDR1,1,30),!
. I $L(ADDR2) W ?49,$E(ADDR2,1,30),!
. I $L(ADDR3) W ?49,$E(ADDR3,1,30),!
. I $L(CSZ) W ?49,$E(CSZ,1,30),!
. I $L(DGCNTRY) W ?49,$E(DGCNTRY,1,30),!
. I $L(SOURCE) W ?49,"SOURCE: ",SOURCE,!
. I $L(SITE) W ?49,"SITE: ",SITE
. I $L(BAI) W !?49,"BAI: ",BAI
. 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
PCP(PCODE,CITY,PROV) ;format postal code, city, province for foreign address
N X
S X=""
I $L(PCODE) S X=PCODE
I $L(CITY) D
. I $L(X) S X=X_" "_CITY Q
. S X=CITY
.Q
I $L(PROV) D
. I $L(X) S X=X_" "_PROV Q
. S X=PROV
. 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
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIVMADDRP 8112 printed Sep 23, 2025@19:36:28 Page 2
IVMADDRP ;ALB/PHH,EG,ERC,BAJ,CKN - IVM ADDRESS UPLOAD LOG REPORT ; 7/11/06 4:36pm
+1 ;;2.0;INCOME VERIFICATION MATCH;**108,106,115**; 21-OCT-94;Build 28
+2 ;
+3 ; This routine list veterans who have had more than one address
+4 ; change in the past 90 days.
+5 ;
+6 NEW SDATE,EDATE,HDR,MSG,%ZIS,ZTRTN,ZTDESC,ZTSAVE,PAGE,ZTSK,ZTREQ,POP,X
+7 NEW BDT,U,DFN,SO
+8 SET U="^"
SET DFN=""
SET SO=""
+9 SET DOS=$$DOS
+10 IF DOS="^"
QUIT
+11 SET X=$$ENDDATE
+12 IF X=""
QUIT
+13 SET BDT=$PIECE(X,"^",1)
+14 IF DOS="D"
Begin DoDot:1
+15 SET DFN=$$GETPAT
+16 QUIT
End DoDot:1
IF DFN=""
QUIT
+17 IF DOS="S"
SET SO=$$SORTORD
IF SO="^"
QUIT
+18 SET (SDATE,EDATE,HDR)=""
+19 SET EDATE=$$FMADD^XLFDT(BDT)
IF EDATE=""
QUIT
+20 SET SDATE=$$FMADD^XLFDT(EDATE,-90)
+21 ;
+22 ; Get report device. Queue report if requested
+23 SET MSG(1)=""
+24 SET MSG(2)="This report may take a long time to generate. It is recommended that the report"
+25 SET MSG(3)="be queued to print."
+26 SET MSG(4)=""
+27 DO BMES^XPDUTL(.MSG)
+28 KILL IOP,%ZIS
+29 SET %ZIS="MQ"
+30 DO ^%ZIS
IF POP
WRITE !!,"Report Cancelled!"
QUIT
+31 IF $DATA(IO("Q"))
Begin DoDot:1
+32 SET ZTRTN="START^IVMADDRP"
+33 SET ZTDESC="IVM Address Change Log Report"
+34 SET (ZTSAVE("PAGE"),ZTSAVE("SDATE"),ZTSAVE("EDATE"))=""
+35 SET (ZTSAVE("DOS"),ZTSAVE("DFN"),ZTSAVE("SO"))=""
+36 DO ^%ZTLOAD
+37 WRITE !!,"Report "_$SELECT($DATA(ZTSK):"Queued!",1:"Cancelled!")
+38 DO HOME^%ZIS
+39 QUIT
End DoDot:1
QUIT
+40 DO START
DO ^%ZISC
+41 QUIT
DOS() ;detail or summary
+1 NEW DIR,Y,X
+2 SET DIR(0)="SA^D:Detail;S:Summary"
+3 SET DIR("A")="Select Type of Report to Run: "
+4 DO ^DIR
+5 QUIT Y
+6 ;
GETPAT() ;get a patient
+1 NEW DIC,Y,X,U
+2 SET DIC="^DPT("
SET DIC(0)="AEQZM"
DO ^DIC
+3 QUIT $SELECT($PIECE(Y,U,1)>0:$PIECE(Y,U,1),1:"")
+4 ;
ENDDATE() ;get an end date, default to TODAY
+1 NEW DIR,Y,X
+2 SET DIR(0)="D^::EX"
SET DIR("?")="^D HELP^%DTC"
SET DIR("B")=$$FMTE^XLFDT(DT)
+3 SET DIR("A")="Enter End Date of 90 Day Window: "
+4 DO ^DIR
+5 QUIT $SELECT('Y:"",1:Y)
+6 ;
SORTORD() ;get sort order for summary
+1 NEW DIR,Y,X
+2 SET DIR(0)="SA^S:Social Security Number;N:Name then SSN"
+3 SET DIR("A")="What Order Do You Want to See Output: "
+4 DO ^DIR
+5 QUIT Y
+6 ;
START ; Generate Report
+1 NEW CRT,X
+2 KILL ^XTMP("IVMADDRP",$JOB)
+3 SET CRT=$SELECT($EXTRACT(IOST,1,2)="C-":1,1:0)
+4 SET X=$$BUILD(SDATE,EDATE,DOS,DFN,SO)
+5 USE IO
WRITE !
DO REPORT
WRITE !
USE 0
+6 KILL ^XTMP("IVMADDRP",$JOB)
+7 IF $GET(ZTSK)
SET ZTREQ="@"
+8 QUIT
BUILD(SDATE,EDATE,DOS,DFN,SO) ; Build the Report
+1 ;use C index if you are only looking for one DFN
+2 IF $LENGTH(DFN)
DO C
QUIT 1
+3 NEW CHDTTM
+4 SET CHDTTM=SDATE
+5 FOR
SET CHDTTM=$ORDER(^IVM(301.7,"B",CHDTTM))
if CHDTTM=""!(CHDTTM>(EDATE+1))
QUIT
DO ADDIEN
+6 QUIT 1
ADDIEN ;
+1 NEW ADDIEN
+2 SET ADDIEN=0
+3 FOR
SET ADDIEN=$ORDER(^IVM(301.7,"B",CHDTTM,ADDIEN))
if ADDIEN=""
QUIT
DO GETINF
+4 QUIT
C NEW ADDIEN,CHDTTM
+1 SET ADDIEN=""
+2 FOR
SET ADDIEN=$ORDER(^IVM(301.7,"C",DFN,ADDIEN))
if ADDIEN=""
QUIT
Begin DoDot:1
+3 SET CHDTTM=$PIECE($GET(^IVM(301.7,ADDIEN,0)),"^",1)
+4 IF (CHDTTM>SDATE)
IF (CHDTTM<(EDATE+1))
DO GETINF
+5 QUIT
End DoDot:1
+6 QUIT
GETINF ;
+1 NEW NODE0,NODE1,DFN,SSN,NAME,ADDR1,ADDR2,CITY,STATE,ZIP,SORT1,SORT2,U
+2 NEW SOURCE,SIEN,SITE,PROV,PCODE,COUNTRY,DGBAI,BAI,ADDR3,NODE2
+3 SET U="^"
SET SITE=""
+4 SET NODE0=$GET(^IVM(301.7,ADDIEN,0))
+5 SET NODE1=$GET(^IVM(301.7,ADDIEN,1))
+6 SET NODE2=$GET(^IVM(301.7,ADDIEN,2))
+7 SET DFN=$PIECE(NODE0,"^",2)
+8 if DFN=""
QUIT
+9 if '$DATA(^DPT(DFN))
QUIT
+10 SET SSN=$PIECE($GET(^DPT(DFN,0)),"^",9)
+11 if SSN=""
QUIT
+12 SET NAME=$PIECE($GET(^DPT(DFN,0)),"^",1)
+13 SET SOURCE=$PIECE(NODE1,"^",4)
SET SIEN=$PIECE(NODE1,"^",3)
+14 IF SIEN
SET SITE=$PIECE($GET(^DIC(4,SIEN,0)),"^",1)
+15 SET ADDR1=$PIECE(NODE1,"^",6)
+16 SET ADDR2=$PIECE(NODE1,"^",7)
+17 SET ADDR3=$PIECE(NODE2,"^",1)
+18 SET CITY=$PIECE(NODE1,"^",8)
+19 SET STATE=$PIECE(NODE1,"^",10)
+20 IF STATE'=""
IF $DATA(^DIC(5,STATE,0))
SET STATE=$PIECE(^DIC(5,STATE,0),"^",2)
+21 SET ZIP=$PIECE(NODE1,"^",11)
+22 SET PROV=$PIECE(NODE1,"^",12)
+23 SET PCODE=$PIECE(NODE1,"^",13)
+24 SET COUNTRY=$PIECE(NODE1,"^",14)
+25 IF COUNTRY'=""
IF $DATA(^HL(779.004,"B",COUNTRY,0))
SET COUNTRY=$$CNTRYI^DGADDUTL(COUNTRY)
+26 IF COUNTRY=-1
SET COUNTRY="UNKNOWN COUNTRY"
+27 SET DGBAI=$PIECE(NODE1,"^",15)
+28 SET BAI=$SELECT(DGBAI=1:"UNDELIVERABLE",DGBAI=2:"HOMELESS",DGBAI=3:"OTHER",DGBAI=4:"ADDRESS NOT FOUND",1:"")
+29 IF DOS="D"
Begin DoDot:1
+30 SET ^XTMP("IVMADDRP",$JOB,SSN,CHDTTM)=ADDIEN_"^"_DFN_"^"_NAME_"^"_ADDR1_"^"_ADDR2_"^"_CITY_"^"_STATE_"^"_ZIP_"^"_SOURCE_"^"_SITE_"^"_PROV_"^"_PCODE_"^"_COUNTRY_"^"_BAI_"^"_ADDR3
+31 SET ^XTMP("IVMADDRP",$JOB,SSN)=$GET(^XTMP("IVMADDRP",$JOB,SSN))+1
+32 QUIT
End DoDot:1
QUIT
+33 IF DOS="S"
Begin DoDot:1
+34 SET SORT1=$SELECT(SO="S":SSN,1:NAME)
IF NAME=""
SET SORT1="UNKNOWN"
+35 SET SORT2=$SELECT(SO="S":0,1:SSN)
+36 SET ^XTMP("IVMADDRP",$JOB,SORT1,SORT2,"INF")=NAME_U_SSN
+37 SET ^XTMP("IVMADDRP",$JOB,SORT1,SORT2,"DATE",CHDTTM)=""
+38 SET ^XTMP("IVMADDRP",$JOB,SORT1,SORT2)=$GET(^XTMP("IVMADDRP",$JOB,SORT1,SORT2))+1
+39 QUIT
End DoDot:1
+40 QUIT
REPORT ; Display the Report
+1 DO HEADER
+2 IF '$DATA(^XTMP("IVMADDRP",$JOB))
Begin DoDot:1
+3 NEW X
SET X="****** NOTHING TO REPORT ******"
WRITE !?80-$LENGTH(X)\2,X,!
+4 QUIT
End DoDot:1
QUIT
+5 IF DOS="S"
DO SUMMARY
QUIT
+6 NEW SSN
+7 ;
+8 SET SSN=""
+9 FOR
SET SSN=$ORDER(^XTMP("IVMADDRP",$JOB,SSN))
if SSN=""
QUIT
DO DETAIL
+10 QUIT
DETAIL NEW NAME,CHDTTM,ADDR,ADDR2,CITY,STATE,ZIP,CSZ
+1 NEW ADDR1,ADDR2,X,U,QUIT,CNT,SITE,SOURCE,DGCNTRY,DGFOR,ADDR3,BAI
+2 SET CHDTTM=""
SET U="^"
SET QUIT=0
SET CNT=0
+3 IF $GET(^XTMP("IVMADDRP",$JOB,SSN))'>1
QUIT
+4 FOR
SET CHDTTM=$ORDER(^XTMP("IVMADDRP",$JOB,SSN,CHDTTM))
if CHDTTM=""!(QUIT)
QUIT
Begin DoDot:1
+5 SET X=$GET(^XTMP("IVMADDRP",$JOB,SSN,CHDTTM))
+6 SET NAME=$PIECE(X,U,3)
+7 SET ADDR1=$PIECE(X,U,4)
+8 SET ADDR2=$PIECE(X,U,5)
+9 SET ADDR3=$PIECE(X,U,15)
+10 SET CITY=$PIECE(X,U,6)
+11 SET STATE=$PIECE(X,U,7)
+12 SET ZIP=$PIECE(X,U,8)
+13 SET SOURCE=$PIECE(X,U,9)
+14 SET SITE=$PIECE(X,U,10)
+15 SET PROV=$PIECE(X,U,11)
+16 SET PCODE=$PIECE(X,U,12)
+17 SET COUNTRY=$PIECE(X,U,13)
+18 SET BAI=$PIECE(X,U,14)
+19 SET DGCNTRY=$$CNTRYI^DGADDUTL(COUNTRY)
+20 SET DGFOR=$$FORIEN^DGADDUTL(COUNTRY)
+21 IF DGFOR=-1
SET DGCNTRY="UNKNOWN COUNTRY"
SET DGFOR=1
+22 IF ($Y+6)>IOSL
DO HEADER
IF QUIT
QUIT
+23 WRITE !,$$FSSN(SSN),?12,$EXTRACT(NAME,1,20)
+24 WRITE ?35,$$FMTE^XLFDT($PIECE(CHDTTM,".",1))
+25 IF DGFOR=0
SET CSZ=$$CSZ(CITY,STATE,ZIP)
+26 IF DGFOR=1
SET CSZ=$$PCP(PCODE,CITY,PROV)
+27 WRITE ?49,$EXTRACT(ADDR1,1,30),!
+28 IF $LENGTH(ADDR2)
WRITE ?49,$EXTRACT(ADDR2,1,30),!
+29 IF $LENGTH(ADDR3)
WRITE ?49,$EXTRACT(ADDR3,1,30),!
+30 IF $LENGTH(CSZ)
WRITE ?49,$EXTRACT(CSZ,1,30),!
+31 IF $LENGTH(DGCNTRY)
WRITE ?49,$EXTRACT(DGCNTRY,1,30),!
+32 IF $LENGTH(SOURCE)
WRITE ?49,"SOURCE: ",SOURCE,!
+33 IF $LENGTH(SITE)
WRITE ?49,"SITE: ",SITE
+34 IF $LENGTH(BAI)
WRITE !?49,"BAI: ",BAI
+35 SET CNT=CNT+1
+36 QUIT
End DoDot:1
+37 IF 'QUIT
DO TOTAL(CNT)
+38 QUIT
SUMMARY NEW SORT1,QUIT,CNT
+1 SET SORT1=""
SET QUIT=0
SET CNT=0
+2 FOR
SET SORT1=$ORDER(^XTMP("IVMADDRP",$JOB,SORT1))
if SORT1=""!(QUIT)
QUIT
DO SORT2
+3 IF 'QUIT
DO TOTAL(CNT)
+4 QUIT
SORT2 NEW NAME,SSN
+1 SET SORT2=""
+2 FOR
SET SORT2=$ORDER(^XTMP("IVMADDRP",$JOB,SORT1,SORT2))
if SORT2=""!(QUIT)
QUIT
Begin DoDot:1
+3 IF $GET(^XTMP("IVMADDRP",$JOB,SORT1,SORT2))'>1
QUIT
+4 DO SUMPR
SET CNT=CNT+1
+5 QUIT
End DoDot:1
+6 QUIT
SUMPR NEW X,U
+1 SET U="^"
+2 SET X=$GET(^XTMP("IVMADDRP",$JOB,SORT1,SORT2,"INF"))
+3 SET NAME=$PIECE(X,U,1)
SET SSN=$PIECE(X,U,2)
+4 IF ($Y+2)>IOSL
DO HEADER
IF QUIT
QUIT
+5 WRITE !,$$FSSN(SSN),?12,$EXTRACT(NAME,1,20)
+6 WRITE ?35,$$FMTE^XLFDT($ORDER(^XTMP("IVMADDRP",$JOB,SORT1,SORT2,"DATE",""),-1))
+7 SET X=$GET(^XTMP("IVMADDRP",$JOB,SORT1,SORT2))
+8 WRITE ?73,$JUSTIFY($FNUMBER(X,","),5)
+9 QUIT
TOTAL(CNT) ;
+1 IF ($Y+2)>IOSL
DO HEADER
+2 WRITE !!,"Total records found meeting criteria: ",CNT,!
+3 QUIT
CSZ(CITY,STATE,ZIP) ;format city, state and zip into one line
+1 NEW X
+2 SET X=""
+3 IF $LENGTH(CITY)
SET X=CITY
+4 IF $LENGTH(STATE)
Begin DoDot:1
+5 IF $LENGTH(X)
SET X=X_", "_STATE
QUIT
+6 SET X=STATE
+7 QUIT
End DoDot:1
+8 IF $LENGTH(ZIP)
Begin DoDot:1
+9 IF $LENGTH(X)
SET X=X_" "_ZIP
QUIT
+10 SET X=ZIP
+11 QUIT
End DoDot:1
+12 QUIT X
PCP(PCODE,CITY,PROV) ;format postal code, city, province for foreign address
+1 NEW X
+2 SET X=""
+3 IF $LENGTH(PCODE)
SET X=PCODE
+4 IF $LENGTH(CITY)
Begin DoDot:1
+5 IF $LENGTH(X)
SET X=X_" "_CITY
QUIT
+6 SET X=CITY
+7 QUIT
End DoDot:1
+8 IF $LENGTH(PROV)
Begin DoDot:1
+9 IF $LENGTH(X)
SET X=X_" "_PROV
QUIT
+10 SET X=PROV
+11 QUIT
End DoDot:1
+12 QUIT X
FSSN(SSN) ; Format the SSN
+1 NEW FMTSSN
+2 IF SSN="NO SSN"
QUIT SSN
+3 IF $LENGTH(SSN)=9
SET FMTSSN=SSN
+4 ; Account for pseudo-SSN
IF $LENGTH(SSN)>9
SET FMTSSN=$EXTRACT(SSN,1,10)
+5 IF $LENGTH(SSN)<9
Begin DoDot:1
+6 SET FMTSSN=""
+7 FOR FMTSSN=$LENGTH(SSN):1:9
SET FMTSSN=FMTSSN_"0"
+8 SET FMTSSN=FMTSSN_SSN
+9 QUIT
End DoDot:1
+10 QUIT FMTSSN
+1 NEW IDX,PGHDR
+2 SET QUIT=0
+3 IF $GET(CRT)
IF ($GET(PAGE)>0)
IF $$PAUSE(0)
SET QUIT=1
QUIT
+4 SET PAGE=$GET(PAGE,0)
SET PAGE=PAGE+1
SET PGHDR="Page: "_$JUSTIFY(PAGE,3)
+5 WRITE #
+6 ; Additional $C to clear screen in Cache'
IF $GET(CRT)
WRITE $CHAR(27,91,72,27,91,74)
+7 SET IDX=""
SET IDX=$ORDER(HDR(IDX))
+8 WRITE "IVM ADDRESS CHANGE LOG REPORT",?71,PGHDR
+9 WRITE !,$$FMTE^XLFDT(SDATE)_" THRU "_$$FMTE^XLFDT(EDATE)
+10 IF DOS="D"
Begin DoDot:1
+11 WRITE !!,"SSN",?12,"NAME",?35,"CHANGE DATE",?49,"PRIOR ADDRESS"
+12 WRITE !,"---",?12,"----",?35,"-----------",?49,"--------------"
+13 QUIT
End DoDot:1
+14 IF DOS="S"
Begin DoDot:1
+15 WRITE !!,"SSN",?12,"NAME",?35,"LAST UPDATED",?69,"# ENTRIES"
+16 WRITE !,"---",?12,"----",?35,"------------",?69,"---------"
+17 QUIT
End DoDot:1
+18 QUIT
PAUSE(RESP) ; Prompt user for next page or quit
+1 NEW DIR,DIRUT,DUOUT,DTOUT,U,X,Y
+2 WRITE !
+3 SET DIR(0)="E"
+4 DO ^DIR
+5 IF 'Y
SET RESP=1
+6 QUIT RESP
