AGLSSN2 ; IHS/ASDS/EFG - LISTING OF PATIENTS W/O SSN ;
;;7.1;PATIENT REGISTRATION;**4**;AUG 25,2005
;
;This routine will go through VA Patient file, looking for people with
;SSN
;
PTS ;
S DIR(0)="Y"
S DIR("A",1)="Unless specified, ONLY ACTIVE PATIENTS will be included."
S DIR("A")="Do you want to include inactive/deceased patients?"
S DIR("B")="N"
D ^DIR K DIR
S AGPTS=Y
Q:$D(DUOUT)!$D(DTOUT)!$D(DFOUT)
W1 W !!! S %ZIS="Q",%ZIS("B")="" D ^%ZIS G:'$D(IO)!(POP) QUIT
S AG("ION")=ION G:$D(IO("Q")) QUE G PROC
PRQUE ;ENTER FROM TASK MANAGER
PROC ;
K ^TMP($J)
S AGBM=IOSL-10
D NOW^%DTC
S Y=X
D DD^%DT
S AGDATE=Y
S D0=0
F S D0=$O(^DPT(D0)) Q:D0="" D
.;check active/inactive/deleted
.S AGNONACT=$P($G(^AUPNPAT(D0,41,DUZ(2),0)),U,3)
.S AGDEC=$P($G(^DPT(D0,.35)),U)
.I AGPTS="0",$G(AGNONACT)'=""!($G(AGDEC)'="") Q
.;check for ssn
.S AGSSN=+$P($G(^DPT(D0,0)),U,9)
.I $G(AGSSN)'=0 D
..S AGREASON=$P($G(^AUPNPAT(D0,0)),U,23)
..S AGNAME=$P($G(^DPT(D0,0)),U)
..S AGDOB=$P($G(^DPT(D0,0)),U,3)
..S AGHRN=$P($G(^AUPNPAT(D0,41,DUZ(2),0)),U,2)
..Q:AGHRN=""
..S:AGDOB="" AGDOB="NONE"
..S:AGREASON="" AGREASON="NONE"
..Q:AGNAME=""
..S ^TMP($J,AGREASON,AGNAME,AGHRN,AGDOB)=AGSSN
WRITE ;
K AGRECS
S AGPAGE=1
S AGRECS=0
S AGFLAG=0
D HDR
S (AGREASON,AGNAME,AGHRN,AGDOB,AGEND)=""
F S AGREASON=$O(^TMP($J,AGREASON)) Q:AGREASON="" D Q:AGEND
.F S AGNAME=$O(^TMP($J,AGREASON,AGNAME)) Q:AGNAME="" D Q:AGEND
..F S AGHRN=$O(^TMP($J,AGREASON,AGNAME,AGHRN)) Q:AGHRN="" D Q:AGEND
...F S AGDOB=$O(^TMP($J,AGREASON,AGNAME,AGHRN,AGDOB)) Q:AGDOB="" D Q:AGEND
....S AGSSN=$G(^TMP($J,AGREASON,AGNAME,AGHRN,AGDOB))
....I AGREASON'="NONE" S AGR=$P($G(^AUTTSSN(AGREASON,0)),U,2)
....I AGREASON="NONE" S AGR="Not yet verified by SSA"
....S:AGR="" AGR="NONE" ;IHS/SD/TPF AG*7.1*4 NO SERVICE CALL
....S Y=AGDOB
....D DD^%DT
....S AGD=Y
....W !,AGSSN,?10,$E(AGR,1,24),?36,$E(AGNAME,1,23),?60,AGHRN,?68,AGD
....S AGRECS(AGR)=$G(AGRECS(AGR))+1
....S AGRECS=AGRECS+1
....I $Y>AGBM D
.....D RTRN^AG
.....I $D(DUOUT)!$D(DTOUT)!$D(DTOUT) S AGEND=1 G QUIT
.....D HDR
I 'AGEND D END
Q
HDR U IO I IOST["C" W $$S^AGVDF("IOF")
D CPI^AG ;Conf. patient info thing
W !,?64,AGDATE
W !,?5,$P(^AUTTLOC(DUZ(2),0),U,2),?27,"LISTING OF PATIENTS WITH SSN",?70,"PAGE ",AGPAGE
W !,"SSN",?10,"REASON CODE FOR SSN",?35,"NAME",?60,"HRN",?68,"DOB",!
F X=1:1:80 W "="
S AGPAGE=AGPAGE+1
Q
END ;
S AGR=""
W !,"TOTAL PATIENTS WITH SSN: ",AGRECS
W !,"TOTALS FOR EACH REASON CODE:"
F S AGR=$O(AGRECS(AGR)) Q:AGR="" D
.W !,?5,AGR_": ",$G(AGRECS(AGR))
K ^TMP($J)
K AGREASON,AGNAME,AGHRN,AGDOB
K AGSSN,D0,AGPTS,AGBM,AGD,AGDATE,AGDEC,AGFLAG,AGIEN,AGMVDF
K AGNONACT,AGPAGE,AGR,AGRECS
QUIT D ^%ZISC K AG
Q
QUE K IO("Q") S ZTRTN="PRQUE^AGLSSN2",ZTDESC="LISTING OF PATIENTS WITH SSN" F AG="AG(""ION"")" S ZTSAVE("AG*")=""
D ^%ZTLOAD W:$D(ZTSK) !,"REQUEST QUEUED!",!,"#",ZTSK G QUIT
AGLSSN2 ; IHS/ASDS/EFG - LISTING OF PATIENTS W/O SSN ;
+1 ;;7.1;PATIENT REGISTRATION;**4**;AUG 25,2005
+2 ;
+3 ;This routine will go through VA Patient file, looking for people with
+4 ;SSN
+5 ;
PTS ;
+1 SET DIR(0)="Y"
+2 SET DIR("A",1)="Unless specified, ONLY ACTIVE PATIENTS will be included."
+3 SET DIR("A")="Do you want to include inactive/deceased patients?"
+4 SET DIR("B")="N"
+5 DO ^DIR
KILL DIR
+6 SET AGPTS=Y
+7 IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DFOUT)
QUIT
W1 WRITE !!!
SET %ZIS="Q"
SET %ZIS("B")=""
DO ^%ZIS
IF '$DATA(IO)!(POP)
GOTO QUIT
+1 SET AG("ION")=ION
IF $DATA(IO("Q"))
GOTO QUE
GOTO PROC
PRQUE ;ENTER FROM TASK MANAGER
PROC ;
+1 KILL ^TMP($JOB)
+2 SET AGBM=IOSL-10
+3 DO NOW^%DTC
+4 SET Y=X
+5 DO DD^%DT
+6 SET AGDATE=Y
+7 SET D0=0
+8 FOR
SET D0=$ORDER(^DPT(D0))
IF D0=""
QUIT
Begin DoDot:1
+9 ;check active/inactive/deleted
+10 SET AGNONACT=$PIECE($GET(^AUPNPAT(D0,41,DUZ(2),0)),U,3)
+11 SET AGDEC=$PIECE($GET(^DPT(D0,.35)),U)
+12 IF AGPTS="0"
IF $GET(AGNONACT)'=""!($GET(AGDEC)'="")
QUIT
+13 ;check for ssn
+14 SET AGSSN=+$PIECE($GET(^DPT(D0,0)),U,9)
+15 IF $GET(AGSSN)'=0
Begin DoDot:2
+16 SET AGREASON=$PIECE($GET(^AUPNPAT(D0,0)),U,23)
+17 SET AGNAME=$PIECE($GET(^DPT(D0,0)),U)
+18 SET AGDOB=$PIECE($GET(^DPT(D0,0)),U,3)
+19 SET AGHRN=$PIECE($GET(^AUPNPAT(D0,41,DUZ(2),0)),U,2)
+20 IF AGHRN=""
QUIT
+21 IF AGDOB=""
SET AGDOB="NONE"
+22 IF AGREASON=""
SET AGREASON="NONE"
+23 IF AGNAME=""
QUIT
+24 SET ^TMP($JOB,AGREASON,AGNAME,AGHRN,AGDOB)=AGSSN
End DoDot:2
End DoDot:1
WRITE ;
+1 KILL AGRECS
+2 SET AGPAGE=1
+3 SET AGRECS=0
+4 SET AGFLAG=0
+5 DO HDR
+6 SET (AGREASON,AGNAME,AGHRN,AGDOB,AGEND)=""
+7 FOR
SET AGREASON=$ORDER(^TMP($JOB,AGREASON))
IF AGREASON=""
QUIT
Begin DoDot:1
+8 FOR
SET AGNAME=$ORDER(^TMP($JOB,AGREASON,AGNAME))
IF AGNAME=""
QUIT
Begin DoDot:2
+9 FOR
SET AGHRN=$ORDER(^TMP($JOB,AGREASON,AGNAME,AGHRN))
IF AGHRN=""
QUIT
Begin DoDot:3
+10 FOR
SET AGDOB=$ORDER(^TMP($JOB,AGREASON,AGNAME,AGHRN,AGDOB))
IF AGDOB=""
QUIT
Begin DoDot:4
+11 SET AGSSN=$GET(^TMP($JOB,AGREASON,AGNAME,AGHRN,AGDOB))
+12 IF AGREASON'="NONE"
SET AGR=$PIECE($GET(^AUTTSSN(AGREASON,0)),U,2)
+13 IF AGREASON="NONE"
SET AGR="Not yet verified by SSA"
+14 ;IHS/SD/TPF AG*7.1*4 NO SERVICE CALL
IF AGR=""
SET AGR="NONE"
+15 SET Y=AGDOB
+16 DO DD^%DT
+17 SET AGD=Y
+18 WRITE !,AGSSN,?10,$EXTRACT(AGR,1,24),?36,$EXTRACT(AGNAME,1,23),?60,AGHRN,?68,AGD
+19 SET AGRECS(AGR)=$GET(AGRECS(AGR))+1
+20 SET AGRECS=AGRECS+1
+21 IF $Y>AGBM
Begin DoDot:5
+22 DO RTRN^AG
+23 IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DTOUT)
SET AGEND=1
GOTO QUIT
+24 DO HDR
End DoDot:5
End DoDot:4
IF AGEND
QUIT
End DoDot:3
IF AGEND
QUIT
End DoDot:2
IF AGEND
QUIT
End DoDot:1
IF AGEND
QUIT
+25 IF 'AGEND
DO END
+26 QUIT
HDR USE IO
IF IOST["C"
WRITE $$S^AGVDF("IOF")
+1 ;Conf. patient info thing
DO CPI^AG
+2 WRITE !,?64,AGDATE
+3 WRITE !,?5,$PIECE(^AUTTLOC(DUZ(2),0),U,2),?27,"LISTING OF PATIENTS WITH SSN",?70,"PAGE ",AGPAGE
+4 WRITE !,"SSN",?10,"REASON CODE FOR SSN",?35,"NAME",?60,"HRN",?68,"DOB",!
+5 FOR X=1:1:80
WRITE "="
+6 SET AGPAGE=AGPAGE+1
+7 QUIT
END ;
+1 SET AGR=""
+2 WRITE !,"TOTAL PATIENTS WITH SSN: ",AGRECS
+3 WRITE !,"TOTALS FOR EACH REASON CODE:"
+4 FOR
SET AGR=$ORDER(AGRECS(AGR))
IF AGR=""
QUIT
Begin DoDot:1
+5 WRITE !,?5,AGR_": ",$GET(AGRECS(AGR))
End DoDot:1
+6 KILL ^TMP($JOB)
+7 KILL AGREASON,AGNAME,AGHRN,AGDOB
+8 KILL AGSSN,D0,AGPTS,AGBM,AGD,AGDATE,AGDEC,AGFLAG,AGIEN,AGMVDF
+9 KILL AGNONACT,AGPAGE,AGR,AGRECS
QUIT DO ^%ZISC
KILL AG
+1 QUIT
QUE KILL IO("Q")
SET ZTRTN="PRQUE^AGLSSN2"
SET ZTDESC="LISTING OF PATIENTS WITH SSN"
FOR AG="AG(""ION"")"
SET ZTSAVE("AG*")=""
+1 DO ^%ZTLOAD
IF $DATA(ZTSK)
WRITE !,"REQUEST QUEUED!",!,"#",ZTSK
GOTO QUIT
