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
