- AGLSSN ; IHS/ASDS/EFG - LISTING OF PATIENTS W/O SSN ;
- ;;7.1;PATIENT REGISTRATION;;AUG 25,2005
- ;
- ;This routine will go through VA Patient file, looking for people with
- ;no 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,24)
- ..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=$S(AGREASON=1:"NOT AVAILABLE",AGREASON=2:"PATIENT REFUSED",AGREASON=3:"PATIENT WILL SUBMIT",1:"REASON FOR NO SSN NOT YET ENTERED")
- ..Q:AGNAME=""
- ..S ^TMP($J,AGREASON,AGNAME,AGHRN,AGDOB)=""
- 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 AGR=AGREASON
- ....S Y=AGDOB
- ....D DD^%DT
- ....S AGD=Y
- ....W !,AGR,?35,AGNAME,?59,AGHRN,?67,AGD
- ....S AGRECS=AGRECS+1
- ....I $Y>AGBM D
- .....D RTRN^AG
- .....I $D(DUOUT)!$D(DTOUT)!$D(DTOUT) S AGEND=1 G END
- .....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 W/O SSN",?70,"PAGE ",AGPAGE
- W !,"REASON FOR NO SSN",?35,"NAME",?59,"HRN",?67,"DOB",!
- F X=1:1:80 W "="
- S AGPAGE=AGPAGE+1
- Q
- END ;
- W !!,"TOTAL PEOPLE LACKING SSN: ",AGRECS
- K ^TMP($J)
- K AGREASON,AGNAME,AGHRN,AGDOB
- K AGSSN,D0,AGPTS,AGRECS
- K AGBM,AGD,AGDATE,AGDEC,AGFLAG,AGIEN,AGMVDF,AGNONACT,AGPAGE,AGR
- QUIT D ^%ZISC K AG
- Q
- QUE K IO("Q") S ZTRTN="PRQUE^AGLSSN",ZTDESC="LISTING OF PATIENTS W/O SSN-QUE" F AG="AG(""ION"")" S ZTSAVE("AG*")=""
- D ^%ZTLOAD W:$D(ZTSK) !,"REQUEST QUEUED!",!,"#",ZTSK G QUIT
- AGLSSN ; IHS/ASDS/EFG - LISTING OF PATIENTS W/O SSN ;
- +1 ;;7.1;PATIENT REGISTRATION;;AUG 25,2005
- +2 ;
- +3 ;This routine will go through VA Patient file, looking for people with
- +4 ;no 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
- +8 ;
- 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,24)
- +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 SET AGREASON=$SELECT(AGREASON=1:"NOT AVAILABLE",AGREASON=2:"PATIENT REFUSED",AGREASON=3:"PATIENT WILL SUBMIT",1:"REASON FOR NO SSN NOT YET ENTERED")
- +23 IF AGNAME=""
- QUIT
- +24 SET ^TMP($JOB,AGREASON,AGNAME,AGHRN,AGDOB)=""
- 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 AGR=AGREASON
- +12 SET Y=AGDOB
- +13 DO DD^%DT
- +14 SET AGD=Y
- +15 WRITE !,AGR,?35,AGNAME,?59,AGHRN,?67,AGD
- +16 SET AGRECS=AGRECS+1
- +17 IF $Y>AGBM
- Begin DoDot:5
- +18 DO RTRN^AG
- +19 IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DTOUT)
- SET AGEND=1
- GOTO END
- +20 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
- +21 IF 'AGEND
- DO END
- +22 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 W/O SSN",?70,"PAGE ",AGPAGE
- +4 WRITE !,"REASON FOR NO SSN",?35,"NAME",?59,"HRN",?67,"DOB",!
- +5 FOR X=1:1:80
- WRITE "="
- +6 SET AGPAGE=AGPAGE+1
- +7 QUIT
- END ;
- +1 WRITE !!,"TOTAL PEOPLE LACKING SSN: ",AGRECS
- +2 KILL ^TMP($JOB)
- +3 KILL AGREASON,AGNAME,AGHRN,AGDOB
- +4 KILL AGSSN,D0,AGPTS,AGRECS
- +5 KILL AGBM,AGD,AGDATE,AGDEC,AGFLAG,AGIEN,AGMVDF,AGNONACT,AGPAGE,AGR
- QUIT DO ^%ZISC
- KILL AG
- +1 QUIT
- QUE KILL IO("Q")
- SET ZTRTN="PRQUE^AGLSSN"
- SET ZTDESC="LISTING OF PATIENTS W/O SSN-QUE"
- FOR AG="AG(""ION"")"
- SET ZTSAVE("AG*")=""
- +1 DO ^%ZTLOAD
- IF $DATA(ZTSK)
- WRITE !,"REQUEST QUEUED!",!,"#",ZTSK
- GOTO QUIT
