AGSSLPRT.m

AGSSLPRT ; IHS/ASDS/EFG - PRINT INDIVIDUAL PATIENT LETTER ;   

 ;;7.1;PATIENT REGISTRATION;;AUG 25,2005

 ;

S ;needs DFN

 ;returns AGSST=1 if address incomplete

 ;prints context from the REG Parameters file IEN=site from

 ;^AUTTSITE

 ;pull letter text

 U IO

 I '$D(AGSS(9009061)) S DIC="^AGFAC(",(AGSITE,DA)=$P(^AUTTSITE(1,0),U),DR="200",DIQ="AGSS" D EN^DIQ1

 Q:'$G(DFN)

 ;pull patient information

 S AGIN=$G(^AGFAC(AGSITE,2)),AGBOT=IOSL-$P(AGIN,":",2),AGIN=$P(AGIN,":")

 K DR,AGSS(2),AGSS(900001.41)

 S DA=DFN,DIC="^DPT(",DR=".01;.09;.111;.112;.113;.114;.115;.116;.351",DIQ="AGSS(",DIQ(0)="N" D EN^DIQ1

 K DR S DA=DFN,DIC="^AUPNPAT(",DR="4101",DIQ="AGSS(",DIQ(0)="N",DR(9000001.41)=".02;.04;.05",DA(9000001.41)=AGSITE D EN^DIQ1

 K AGSST

 I ($G(AGSS(2,DFN,.111))]""),($G(AGSS(2,DFN,.115))]""),($G(AGSS(2,DFN,.116))]"") ;test address

 E  S AGSST="A" ;mark if bad address

 I ($G(AGSS(2,DFN,.351))]"") S AGSST=$G(AGSST)_"D" ;mark if date of death

 I ($G(AGSS(9000001.41,AGSITE,.04))]"") S AGSST=$G(AGSST)_"R" ;mark if record disposition is Invalid

 I ($G(AGSS(9000001.41,AGSITE,.05))]"") S AGSST=$G(AGSST)_"S" ;mark if patient status is invalid

 I $G(AGSST)]"" K AGSS(2,DFN),AGSS(9000001.41,AGSITE) Q  ;exit

 W:$Y>1 @IOF

 F I=1:1:5 W !

 W ?5,AGSS(2,DFN,.01),!!,?5,$G(AGSS(9000001.41,AGSITE,.02)),!!

 ;print body of letter

T S DIWL=5,DIWR=75,DIWF="W" K ^TMP($J,"W")

 F AGI=1:1 Q:'$D(AGSS(9009061,AGSITE,200,AGI))  S X=AGSS(9009061,AGSITE,200,AGI) D ^DIWP D  Q:($G(DIROUT)!$G(DUOUT)!$G(DTOUT)!$G(DIRUT))

 .Q:($Y<(IOSL-4))!($G(DUOUT)!$G(DFOUT))  I $E(IOST)="C" K DIR S DIR(0)="E" D ^DIR W @IOF

 Q:($G(DIROUT)!$G(DUOUT)!$G(DTOUT)!$G(DIRUT))

 D ^DIWW

 S AGSSN=$G(AGSS(2,DFN,.09)) I $L(AGSSN)=9 S AGSSN=$E(AGSSN,1,3)_"-"_$E(AGSSN,4,5)_"-"_$E(AGSSN,6,9)

 S X="Social Security Number that is matched   "_AGSSN D ^DIWP,^DIWW K AGSSN

 F AGI=$Y:1:AGBOT W !

A S DIWF="WNI"_AGIN K ^TMP($J,"W")

 S X=AGSS(2,DFN,.01) D ^DIWP

 F AGI=.111:.001:.114 I $D(AGSS(2,DFN,AGI)) S X=AGSS(2,DFN,AGI) D ^DIWP

 S X=$G(AGSS(2,DFN,.115))_"    "_$G(AGSS(2,DFN,.116)) D ^DIWP

 D ^DIWW

 I $E(IOST)="C" K DIR S DIR(0)="E" D ^DIR W @IOF

 K AGSS(2,DFN),DIWF,DIWL,DIWR,DIQ

 Q

INDIV ;EP select and print individual Patient SSN letters

 K AGSS

IND F  S DIC="^AUPNPAT(",DIC(0)="AEQ" D ^DIC Q:Y'>0  S AGSS("INDV",+Y)=""

 S XBRP="INDPRT^AGSSLPRT",XBRX="EX2^AGSSLPRT",XBNS="AGSS" D ^XBDBQUE

 Q

INDPRT ;

 S DFN=0 F  S DFN=$O(AGSS("INDV",DFN)) Q:DFN'>0  D ^AGSSLPRT I $G(AGSST)]"" S AGSS("INDV",DFN)=AGSST K AGSST

 U IO W:$Y>1 @IOF

 D RPTPRT

 U IO W:$Y>1 @IOF

 Q

EX2 ;EP

 K AGSS(2),AGSS(900001.41)

 K AGSS,AGBOT,AGI,AGIN,AGSITE,AGSSPG,AGSSC,AGSSCL,AGSSIEN,AGSSNM,AGSHRN

 Q

RPTPRT ;print summary report

 ;uses AGSS("INDV",DFN)

 S AGSSPG("PG")=1,AGSSPG("HDR")="Report of 'SSN ADDED' Patient Leters "  D AGSSHDR ;print header

 S AGSSC=0,AGSSIEN=0 F  S AGSSIEN=$O(AGSS("INDV",AGSSIEN)) Q:'AGSSIEN  S AGSSNM=$P(^DPT(AGSSIEN,0),U) D

 .S AGSSCL=5+35*(AGSSC#2),AGSHRN=$P($G(^AUPNPAT(AGSSIEN,41,AGSITE,0)),"^",2) W ?AGSSCL,$J(AGSHRN,6)," ",AGSSNM W:(AGSS("INDV",AGSSIEN)]"") " *"_AGSS("INDV",AGSSIEN) I AGSSCL>10 W ! D AGSSPG

 .S AGSSC=AGSSC+1

 W !!,"TOTAL = ",AGSSC H 3

 I $E(IOST)="C" K DIR S DIR(0)="E" D ^DIR W @IOF

 Q

END ;

 K AGSS,AGBOT,AGI,AGIN,AGSITE,AGSSPG,AGSSC,AGSSCL,AGSSIEN,AGSSNM,AGSHRN

 Q

AGSSPG ;EP PAGE CONTROLLER

 ;this utility uses variables AGSSPG("HDR"),AGSSPG("DT"),AGSSPG("LINE"),AGSSPG("PG") ; kill variables by D EAGSSPG

 Q:($Y<(IOSL-4))!($G(DUOUT)!$G(DFOUT))  S:'$D(AGSSPG("PG")) AGSSPG("PG")=0 S AGSSPG("PG")=AGSSPG("PG")+1 I $E(IOST)="C" K DIR S DIR(0)="E" D ^DIR Q:($G(DIROUT)!$G(DUOUT)!$G(DTOUT)!$G(DIRUT))

AGSSHDR ;EP write page header

 W:$Y @IOF W ! Q:'$D(AGSSPG("HDR"))  S:'$D(AGSSPG("LINE")) $P(AGSSPG("LINE"),"-",IOM-2)="" S:'$D(AGSSPG("PG")) AGSSPG("PG")=1 I '$D(AGSSPG("DT")) S %H=$H D YX^%DTC S AGSSPG("DT")=Y

 U IO W ?(IOM-40-$L(AGSSPG("HDR"))/2),AGSSPG("HDR"),?(IOM-40),AGSSPG("DT"),?(IOM-10),"PAGE: ",AGSSPG("PG"),!,AGSSPG("LINE")

AGSSHD ;EP Write column header / message

 W !!,"   * DENOTES INCOMPLETE ADDRESS -- LETTER NOT PRINTED",!!

 Q:($G(DIROUT)!$G(DUOUT)!$G(DTOUT)!$G(DIRUT))

EAGSSPG K AGSSPG("LINE"),AGSSPG("PG"),AGSSPG("HDR"),AGSSPG("DT") Q

AGSSLPRT  ; IHS/ASDS/EFG - PRINT INDIVIDUAL PATIENT LETTER ;   

 +1       ;;7.1;PATIENT REGISTRATION;;AUG 25,2005

 +2       ;

S         ;needs DFN

 +1       ;returns AGSST=1 if address incomplete

 +2       ;prints context from the REG Parameters file IEN=site from

 +3       ;^AUTTSITE

 +4       ;pull letter text

 +5        USE IO

 +6        IF '$DATA(AGSS(9009061))

               SET DIC="^AGFAC("

               SET (AGSITE,DA)=$PIECE(^AUTTSITE(1,0),U)

               SET DR="200"

               SET DIQ="AGSS"

               DO EN^DIQ1

 +7        IF '$GET(DFN)

               QUIT 

 +8       ;pull patient information

 +9        SET AGIN=$GET(^AGFAC(AGSITE,2))

           SET AGBOT=IOSL-$PIECE(AGIN,":",2)

           SET AGIN=$PIECE(AGIN,":")

 +10       KILL DR,AGSS(2),AGSS(900001.41)

 +11       SET DA=DFN

           SET DIC="^DPT("

           SET DR=".01;.09;.111;.112;.113;.114;.115;.116;.351"

           SET DIQ="AGSS("

           SET DIQ(0)="N"

           DO EN^DIQ1

 +12       KILL DR

           SET DA=DFN

           SET DIC="^AUPNPAT("

           SET DR="4101"

           SET DIQ="AGSS("

           SET DIQ(0)="N"

           SET DR(9000001.41)=".02;.04;.05"

           SET DA(9000001.41)=AGSITE

           DO EN^DIQ1

 +13       KILL AGSST

 +14      ;test address

           IF ($GET(AGSS(2,DFN,.111))]"")

               IF ($GET(AGSS(2,DFN,.115))]"")

                   IF ($GET(AGSS(2,DFN,.116))]"")

 +15      ;mark if bad address

          IF '$TEST

               SET AGSST="A"

 +16      ;mark if date of death

           IF ($GET(AGSS(2,DFN,.351))]"")

               SET AGSST=$GET(AGSST)_"D"

 +17      ;mark if record disposition is Invalid

           IF ($GET(AGSS(9000001.41,AGSITE,.04))]"")

               SET AGSST=$GET(AGSST)_"R"

 +18      ;mark if patient status is invalid

           IF ($GET(AGSS(9000001.41,AGSITE,.05))]"")

               SET AGSST=$GET(AGSST)_"S"

 +19      ;exit

           IF $GET(AGSST)]""

               KILL AGSS(2,DFN),AGSS(9000001.41,AGSITE)

               QUIT 

 +20       IF $Y>1

               WRITE @IOF

 +21       FOR I=1:1:5

               WRITE !

 +22       WRITE ?5,AGSS(2,DFN,.01),!!,?5,$GET(AGSS(9000001.41,AGSITE,.02)),!!

 +23      ;print body of letter

T          SET DIWL=5

           SET DIWR=75

           SET DIWF="W"

           KILL ^TMP($JOB,"W")

 +1        FOR AGI=1:1

               IF '$DATA(AGSS(9009061,AGSITE,200,AGI))

                   QUIT 

               SET X=AGSS(9009061,AGSITE,200,AGI)

               DO ^DIWP

               Begin DoDot:1

 +2                IF ($Y<(IOSL-4))!($GET(DUOUT)!$GET(DFOUT))

                       QUIT 

                   IF $EXTRACT(IOST)="C"

                       KILL DIR

                       SET DIR(0)="E"

                       DO ^DIR

                       WRITE @IOF

               End DoDot:1

               IF ($GET(DIROUT)!$GET(DUOUT)!$GET(DTOUT)!$GET(DIRUT))

                   QUIT 

 +3        IF ($GET(DIROUT)!$GET(DUOUT)!$GET(DTOUT)!$GET(DIRUT))

               QUIT 

 +4        DO ^DIWW

 +5        SET AGSSN=$GET(AGSS(2,DFN,.09))

           IF $LENGTH(AGSSN)=9

               SET AGSSN=$EXTRACT(AGSSN,1,3)_"-"_$EXTRACT(AGSSN,4,5)_"-"_$EXTRACT(AGSSN,6,9)

 +6        SET X="Social Security Number that is matched   "_AGSSN

           DO ^DIWP

           DO ^DIWW

           KILL AGSSN

 +7        FOR AGI=$Y:1:AGBOT

               WRITE !

A          SET DIWF="WNI"_AGIN

           KILL ^TMP($JOB,"W")

 +1        SET X=AGSS(2,DFN,.01)

           DO ^DIWP

 +2        FOR AGI=.111:.001:.114

               IF $DATA(AGSS(2,DFN,AGI))

                   SET X=AGSS(2,DFN,AGI)

                   DO ^DIWP

 +3        SET X=$GET(AGSS(2,DFN,.115))_"    "_$GET(AGSS(2,DFN,.116))

           DO ^DIWP

 +4        DO ^DIWW

 +5        IF $EXTRACT(IOST)="C"

               KILL DIR

               SET DIR(0)="E"

               DO ^DIR

               WRITE @IOF

 +6        KILL AGSS(2,DFN),DIWF,DIWL,DIWR,DIQ

 +7        QUIT 

INDIV     ;EP select and print individual Patient SSN letters

 +1        KILL AGSS

IND        FOR 

               SET DIC="^AUPNPAT("

               SET DIC(0)="AEQ"

               DO ^DIC

               IF Y'>0

                   QUIT 

               SET AGSS("INDV",+Y)=""

 +1        SET XBRP="INDPRT^AGSSLPRT"

           SET XBRX="EX2^AGSSLPRT"

           SET XBNS="AGSS"

           DO ^XBDBQUE

 +2        QUIT 

INDPRT    ;

 +1        SET DFN=0

           FOR 

               SET DFN=$ORDER(AGSS("INDV",DFN))

               IF DFN'>0

                   QUIT 

               DO ^AGSSLPRT

               IF $GET(AGSST)]""

                   SET AGSS("INDV",DFN)=AGSST

                   KILL AGSST

 +2        USE IO

           IF $Y>1

               WRITE @IOF

 +3        DO RPTPRT

 +4        USE IO

           IF $Y>1

               WRITE @IOF

 +5        QUIT 

EX2       ;EP

 +1        KILL AGSS(2),AGSS(900001.41)

 +2        KILL AGSS,AGBOT,AGI,AGIN,AGSITE,AGSSPG,AGSSC,AGSSCL,AGSSIEN,AGSSNM,AGSHRN

 +3        QUIT 

RPTPRT    ;print summary report

 +1       ;uses AGSS("INDV",DFN)

 +2       ;print header

           SET AGSSPG("PG")=1

           SET AGSSPG("HDR")="Report of 'SSN ADDED' Patient Leters "

           DO AGSSHDR

 +3        SET AGSSC=0

           SET AGSSIEN=0

           FOR 

               SET AGSSIEN=$ORDER(AGSS("INDV",AGSSIEN))

               IF 'AGSSIEN

                   QUIT 

               SET AGSSNM=$PIECE(^DPT(AGSSIEN,0),U)

               Begin DoDot:1

 +4                SET AGSSCL=5+35*(AGSSC#2)

                   SET AGSHRN=$PIECE($GET(^AUPNPAT(AGSSIEN,41,AGSITE,0)),"^",2)

                   WRITE ?AGSSCL,$JUSTIFY(AGSHRN,6)," ",AGSSNM

                   IF (AGSS("INDV",AGSSIEN)]"")

                       WRITE " *"_AGSS("INDV",AGSSIEN)

                   IF AGSSCL>10

                       WRITE !

                       DO AGSSPG

 +5                SET AGSSC=AGSSC+1

               End DoDot:1

 +6        WRITE !!,"TOTAL = ",AGSSC

           HANG 3

 +7        IF $EXTRACT(IOST)="C"

               KILL DIR

               SET DIR(0)="E"

               DO ^DIR

               WRITE @IOF

 +8        QUIT 

END       ;

 +1        KILL AGSS,AGBOT,AGI,AGIN,AGSITE,AGSSPG,AGSSC,AGSSCL,AGSSIEN,AGSSNM,AGSHRN

 +2        QUIT 

AGSSPG    ;EP PAGE CONTROLLER

 +1       ;this utility uses variables AGSSPG("HDR"),AGSSPG("DT"),AGSSPG("LINE"),AGSSPG("PG") ; kill variables by D EAGSSPG

 +2        IF ($Y<(IOSL-4))!($GET(DUOUT)!$GET(DFOUT))

               QUIT 

           IF '$DATA(AGSSPG("PG"))

               SET AGSSPG("PG")=0

           SET AGSSPG("PG")=AGSSPG("PG")+1

           IF $EXTRACT(IOST)="C"

               KILL DIR

               SET DIR(0)="E"

               DO ^DIR

               IF ($GET(DIROUT)!$GET(DUOUT)!$GET(DTOUT)!$GET(DIRUT))

                   QUIT 

AGSSHDR   ;EP write page header

 +1        IF $Y

               WRITE @IOF

           WRITE !

           IF '$DATA(AGSSPG("HDR"))

               QUIT 

           IF '$DATA(AGSSPG("LINE"))

               SET $PIECE(AGSSPG("LINE"),"-",IOM-2)=""

           IF '$DATA(AGSSPG("PG"))

               SET AGSSPG("PG")=1

           IF '$DATA(AGSSPG("DT"))

               SET %H=$HOROLOG

               DO YX^%DTC

               SET AGSSPG("DT")=Y

 +2        USE IO

           WRITE ?(IOM-40-$LENGTH(AGSSPG("HDR"))/2),AGSSPG("HDR"),?(IOM-40),AGSSPG("DT"),?(IOM-10),"PAGE: ",AGSSPG("PG"),!,AGSSPG("LINE")

AGSSHD    ;EP Write column header / message

 +1        WRITE !!,"   * DENOTES INCOMPLETE ADDRESS -- LETTER NOT PRINTED",!!

 +2        IF ($GET(DIROUT)!$GET(DUOUT)!$GET(DTOUT)!$GET(DIRUT))

               QUIT 

EAGSSPG    KILL AGSSPG("LINE"),AGSSPG("PG"),AGSSPG("HDR"),AGSSPG("DT")

           QUIT