IVMADDRP.m

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

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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---IVMADDRP   8112     printed  Apr 23, 2025@18:14:47                                                                                                                                                                                                    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)