DGPSEU2 ;ALB/ERC - REPORTS FOR PSEUDO SSN ; 1/9/06 7:46am
;;5.3;Registration;**653**;Aug 13, 1993;Build 2
;
;creates a report of all dependents with pseudo SSNs
;can call for one Pseudo SSN Reason or can call for all reasons
;sorted by reason
;
TSK2 ;
N DGQ,DGQUIT,DGREAS,DGXREAS,DGTXT
N ZTRTN,ZTDESC,ZTSK,ZTIO,ZTDTH,POP,IO,IOBS,IOF,IOHG,IOM,ION,IOPAR
N IOS,IOSL,IOST,IOT,IOUPAR,IOXY,%ZIS,ZTSAVE
K ^TMP("DGEVC",$J)
S DGQUIT=0
D QUESREAS^DGPSEUDO Q:DGQUIT
S %ZIS="Q"
D ^%ZIS I $G(POP) D ^%ZISC,HOME^%ZIS W !,"Job Terminated!" Q
I $D(IO("Q")) D Q
. S ZTRTN="RPT2^DGPSEU2"
. S ZTDESC="DEPENDENTS WITH PSEUDO SOCIAL SECURITY NUMBERS"
. S (ZTSAVE("DGXREAS"),ZTSAVE("DGXVET"))=""
. D ^%ZTLOAD
. S DGTXT=$S($G(ZTSK):"Task: "_ZTSK_" Queued.",1:"Error: Process not queued!")
. W !,DGTXT
RPT2 ;
N DGC,DGPAGE,DGQ
S (DGQUIT,DGPAGE)=0
S DGC=0
D LOOP2
D HDR2
I $G(DGC)'>0 W !!?25,"****NO RECORDS TO REPORT****" W ! D PAUSE^DGPSEUDO Q
D REP2(DGXREAS)
D ^%ZISC,HOME^%ZIS
K ^TMP("DGEVC",$J)
Q
LOOP2 ;
I $E(IOST,1,2)["C-" U IO(0) W !!,"Scanning file...."
U IO
N DGCT,DGIEN13,DGX
K ^TMP("DGEVC",$J)
S DGX=999999999
S DGCT=0
S ^TMP("DGEVC",$J,"COUNT")=0
S ^TMP("DGEVC",$J,"COUNT","REFUSED TO PROVIDE")=0
S ^TMP("DGEVC",$J,"COUNT","SSN UNKNOWN/FOLLOW-UP REQUIRED")=0
S ^TMP("DGEVC",$J,"COUNT","NO SSN ASSIGNED")=0
S ^TMP("DGEVC",$J,"COUNT","NULL")=0
F S DGX=$O(^DGPR(408.13,"SSN",DGX)) Q:DGX="" D
. I DGX'["P" Q
. S DGIEN13=0
. F S DGIEN13=$O(^DGPR(408.13,"SSN",DGX,DGIEN13)) Q:'DGIEN13 D
. . Q:'$D(^DGPR(408.13,DGIEN13,0))
. . D PSEU2
Q
PSEU2 ;
N DGARR,DGCT,DGDFN,DGDOB,DGERR,DGIEN12,DGNAM,DGPAT,DGPSSN,DGSSN
I $D(^TMP("DGEVC",$J,DGIEN13)) Q
D GETS^DIQ(408.13,DGIEN13_",",".01;.09;.1","EI","DGARR","DGERR")
I $D(DGERR) K DGERR Q
I $G(DGARR(408.13,DGIEN13_",",.09,"I"))'["P" K DGARR Q
S DGDEPNAM=$G(DGARR(408.13,DGIEN13_",",.01,"I"))
S DGDEPSSN=$G(DGARR(408.13,DGIEN13_",",.09,"I"))
S DGREASON=$G(DGARR(408.13,DGIEN13_",",.1,"E"))
I $G(DGREASON)']"" S DGREASON="NULL"
I DGXREAS'="ALL",DGXREAS'=DGREASON K DGARR Q
S DGIEN12=0
S DGIEN12=$O(^DGPR(408.12,"C",DGIEN13_";DGPR(408.13,",DGIEN12))
I $G(DGIEN12)']"" K DGARR Q
I '$D(^DGPR(408.12,DGIEN12,0)) K DGARR Q
D GETS^DIQ(408.12,DGIEN12_",",".01;.02","EI","DGARR","DGERR")
I $D(DGERR) K DGARR,DGERR Q
S DGDFN=$G(DGARR(408.12,DGIEN12_",",.01,"I"))
I '$D(^DPT(DGDFN)),($G(^DPT(DGDFN,0))']"") K DGARR Q
S DGREL=$G(DGARR(408.12,DGIEN12_",",.02,"E"))
S DGREL=$$GETREL(DGREL)
D GETS^DIQ(2,DGDFN_",",".01;.09","EI","DGARR","DGERR")
I $D(DGERR) K DGARR,DGERR Q
S DGPATNAM=$G(DGARR(2,DGDFN_",",.01,"E"))
S DGPATSSN=$G(DGARR(2,DGDFN_",",.09,"I"))
S DGC=DGC+1
S ^TMP("DGEVC",$J,DGPATNAM,DGDFN,DGDEPNAM,DGIEN13)=DGPATSSN_"^"_DGREL_"^"_DGDEPSSN_"^"_DGREASON
S ^TMP("DGEVC",$J,"COUNT")=DGC
S ^TMP("DGEVC",$J,"COUNT",DGREASON)=$G(^TMP("DGEVC",$J,"COUNT",DGREASON))+1
K DGARR,DGDFN,DGERR,DGDEPNAM,DGDEPSSN,DGPATNAM,DGPATSSN,DGREASON,DGREL
Q
HDR2 ;
N DGDATE,DGL,DGLINE,DGT,Y ;display veteran, non-vet or both
I $E(IOST,1,2)["C-" W @IOF
S DGPAGE=DGPAGE+1
W !?((IOM-46)\2),"Pseudo SSN Report for Means Test Dependents",?70,"Page:"_DGPAGE
S DGT="Report shows "_$S(DGXREAS="NULL":"<NONE ENTERED>",1:DGXREAS)
S DGL=$L(DGT)
W !?((IOM-DGL)\2),DGT
S Y=DT X ^DD("DD") S DGDATE=Y
W !?62,"Date: "_$G(DGDATE)
W !!,"PATIENT",?27,"PATIENT SSN"
W !?5,"DEPENDENT",?38,"RELATIONSHIP",?52,"DEP. PSSN",?64,"PSSN REASON"
N DGZ
W !
F DGZ=1:1:IOM W "-"
Q
REP2(DGXREAS) ;
N DG0,DGCT,DGDNAM,DGIEN,DGN,DGPNAM,DGRR
S (DGDNAM,DGN,DGDFN,DGPNAM)=""
S DGCT=0
F S DGPNAM=$O(^TMP("DGEVC",$J,DGPNAM)) Q:DGPNAM']""!($G(DGQ)) D
. I DGPNAM="COUNT",($O(^TMP("DGEVC",$J,DGPNAM,""))'>0) Q
. F S DGDFN=$O(^TMP("DGEVC",$J,DGPNAM,DGDFN)) Q:DGDFN'>0!($G(DGQ)) D
. . N DG0
. . I $E(IOST,1,2)["C-",($Y>(IOSL-4)) D PAUSE^DGPSEUDO Q:$G(DGQ)
. . I $Y>(IOSL-4) D
. . . W @IOF
. . . D HDR2
. . S DG0=^DPT(DGDFN,0)
. . S DGSSN=$P(DG0,U,9)
. . W !!,$E($G(DGPNAM),1,25),?27,$G(DGSSN)
. . S (DGDNAM,DGIEN)=""
. . F S DGDNAM=$O(^TMP("DGEVC",$J,DGPNAM,DGDFN,DGDNAM)) Q:DGDNAM']""!($G(DGQ)) D
. . . F S DGIEN=$O(^TMP("DGEVC",$J,DGPNAM,DGDFN,DGDNAM,DGIEN)) Q:DGIEN'>0!($G(DGQ)) D
. . . . S DGN=^TMP("DGEVC",$J,DGPNAM,DGDFN,DGDNAM,DGIEN)
. . . . S DGRR=$P(DGN,U,4)
. . . . S DGRR=$S(DGRR["REF":"REF TO PROVIDE",DGRR["UNKN":"SSN UNK-F/U REQ",DGRR["NULL":"<NONE ENTERED>",1:DGRR)
. . . . I $E(IOST,1,2)["C-",($Y>(IOSL-4)) D PAUSE^DGPSEUDO Q:$G(DGQ)
. . . . I $Y>(IOSL-4) D
. . . . . W @IOF
. . . . . D HDR2
. . . . . W !,$E($G(DGPNAM),1,25),?27,$G(DGSSN)
. . . . W !?5,$G(DGDNAM),?38,$E($P(DGN,U,2),1,12),?52,$P(DGN,U,3),?64,$G(DGRR)
. . . . S DGCT=DGCT+1
I DGCT=DGC D
. I $E(IOST,1,2)["C-",($Y>(IOSL-6)) D PAUSE^DGPSEUDO Q:$G(DGQ)
. I $Y>(IOSL-6) D
. . W @IOF
. . D HDR2
. W !!?5,"Total number of dependents with Pseudo SSNs for this report: "_DGC
. I DGXREAS="ALL" D
. . W !?31,"Dependents who REFUSED TO PROVIDE: "_^TMP("DGEVC",$J,"COUNT","REFUSED TO PROVIDE")
. . W !?29,"Dependents who have NO SSN ASSIGNED: "_^TMP("DGEVC",$J,"COUNT","NO SSN ASSIGNED")
. . W !?33,"Dependents who have SSN UNKNOWN: "_^TMP("DGEVC",$J,"COUNT","SSN UNKNOWN/FOLLOW-UP REQUIRED")
. . W !?22,"Dependents who have no PSSN Reason entered: "_^TMP("DGEVC",$J,"COUNT","NULL")
W !
I $E(IOST,1,2)["C-",('$G(DGQ)) D PAUSE^DGPSEUDO
D ^%ZISC,HOME^%ZIS
Q
GETREL(DGREL) ;some relationships will need to be abbreviated to fit the 12
; char spacing limit
I DGREL']"" Q DGREL
I $P(DGREL,"-")="GREAT" S $P(DGREL,"-")="GR"
Q DGREL
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPSEU2 5646 printed Apr 09, 2024@22:05:08 Page 2
DGPSEU2 ;ALB/ERC - REPORTS FOR PSEUDO SSN ; 1/9/06 7:46am
+1 ;;5.3;Registration;**653**;Aug 13, 1993;Build 2
+2 ;
+3 ;creates a report of all dependents with pseudo SSNs
+4 ;can call for one Pseudo SSN Reason or can call for all reasons
+5 ;sorted by reason
+6 ;
TSK2 ;
+1 NEW DGQ,DGQUIT,DGREAS,DGXREAS,DGTXT
+2 NEW ZTRTN,ZTDESC,ZTSK,ZTIO,ZTDTH,POP,IO,IOBS,IOF,IOHG,IOM,ION,IOPAR
+3 NEW IOS,IOSL,IOST,IOT,IOUPAR,IOXY,%ZIS,ZTSAVE
+4 KILL ^TMP("DGEVC",$JOB)
+5 SET DGQUIT=0
+6 DO QUESREAS^DGPSEUDO
if DGQUIT
QUIT
+7 SET %ZIS="Q"
+8 DO ^%ZIS
IF $GET(POP)
DO ^%ZISC
DO HOME^%ZIS
WRITE !,"Job Terminated!"
QUIT
+9 IF $DATA(IO("Q"))
Begin DoDot:1
+10 SET ZTRTN="RPT2^DGPSEU2"
+11 SET ZTDESC="DEPENDENTS WITH PSEUDO SOCIAL SECURITY NUMBERS"
+12 SET (ZTSAVE("DGXREAS"),ZTSAVE("DGXVET"))=""
+13 DO ^%ZTLOAD
+14 SET DGTXT=$SELECT($GET(ZTSK):"Task: "_ZTSK_" Queued.",1:"Error: Process not queued!")
+15 WRITE !,DGTXT
End DoDot:1
QUIT
RPT2 ;
+1 NEW DGC,DGPAGE,DGQ
+2 SET (DGQUIT,DGPAGE)=0
+3 SET DGC=0
+4 DO LOOP2
+5 DO HDR2
+6 IF $GET(DGC)'>0
WRITE !!?25,"****NO RECORDS TO REPORT****"
WRITE !
DO PAUSE^DGPSEUDO
QUIT
+7 DO REP2(DGXREAS)
+8 DO ^%ZISC
DO HOME^%ZIS
+9 KILL ^TMP("DGEVC",$JOB)
+10 QUIT
LOOP2 ;
+1 IF $EXTRACT(IOST,1,2)["C-"
USE IO(0)
WRITE !!,"Scanning file...."
+2 USE IO
+3 NEW DGCT,DGIEN13,DGX
+4 KILL ^TMP("DGEVC",$JOB)
+5 SET DGX=999999999
+6 SET DGCT=0
+7 SET ^TMP("DGEVC",$JOB,"COUNT")=0
+8 SET ^TMP("DGEVC",$JOB,"COUNT","REFUSED TO PROVIDE")=0
+9 SET ^TMP("DGEVC",$JOB,"COUNT","SSN UNKNOWN/FOLLOW-UP REQUIRED")=0
+10 SET ^TMP("DGEVC",$JOB,"COUNT","NO SSN ASSIGNED")=0
+11 SET ^TMP("DGEVC",$JOB,"COUNT","NULL")=0
+12 FOR
SET DGX=$ORDER(^DGPR(408.13,"SSN",DGX))
if DGX=""
QUIT
Begin DoDot:1
+13 IF DGX'["P"
QUIT
+14 SET DGIEN13=0
+15 FOR
SET DGIEN13=$ORDER(^DGPR(408.13,"SSN",DGX,DGIEN13))
if 'DGIEN13
QUIT
Begin DoDot:2
+16 if '$DATA(^DGPR(408.13,DGIEN13,0))
QUIT
+17 DO PSEU2
End DoDot:2
End DoDot:1
+18 QUIT
PSEU2 ;
+1 NEW DGARR,DGCT,DGDFN,DGDOB,DGERR,DGIEN12,DGNAM,DGPAT,DGPSSN,DGSSN
+2 IF $DATA(^TMP("DGEVC",$JOB,DGIEN13))
QUIT
+3 DO GETS^DIQ(408.13,DGIEN13_",",".01;.09;.1","EI","DGARR","DGERR")
+4 IF $DATA(DGERR)
KILL DGERR
QUIT
+5 IF $GET(DGARR(408.13,DGIEN13_",",.09,"I"))'["P"
KILL DGARR
QUIT
+6 SET DGDEPNAM=$GET(DGARR(408.13,DGIEN13_",",.01,"I"))
+7 SET DGDEPSSN=$GET(DGARR(408.13,DGIEN13_",",.09,"I"))
+8 SET DGREASON=$GET(DGARR(408.13,DGIEN13_",",.1,"E"))
+9 IF $GET(DGREASON)']""
SET DGREASON="NULL"
+10 IF DGXREAS'="ALL"
IF DGXREAS'=DGREASON
KILL DGARR
QUIT
+11 SET DGIEN12=0
+12 SET DGIEN12=$ORDER(^DGPR(408.12,"C",DGIEN13_";DGPR(408.13,",DGIEN12))
+13 IF $GET(DGIEN12)']""
KILL DGARR
QUIT
+14 IF '$DATA(^DGPR(408.12,DGIEN12,0))
KILL DGARR
QUIT
+15 DO GETS^DIQ(408.12,DGIEN12_",",".01;.02","EI","DGARR","DGERR")
+16 IF $DATA(DGERR)
KILL DGARR,DGERR
QUIT
+17 SET DGDFN=$GET(DGARR(408.12,DGIEN12_",",.01,"I"))
+18 IF '$DATA(^DPT(DGDFN))
IF ($GET(^DPT(DGDFN,0))']"")
KILL DGARR
QUIT
+19 SET DGREL=$GET(DGARR(408.12,DGIEN12_",",.02,"E"))
+20 SET DGREL=$$GETREL(DGREL)
+21 DO GETS^DIQ(2,DGDFN_",",".01;.09","EI","DGARR","DGERR")
+22 IF $DATA(DGERR)
KILL DGARR,DGERR
QUIT
+23 SET DGPATNAM=$GET(DGARR(2,DGDFN_",",.01,"E"))
+24 SET DGPATSSN=$GET(DGARR(2,DGDFN_",",.09,"I"))
+25 SET DGC=DGC+1
+26 SET ^TMP("DGEVC",$JOB,DGPATNAM,DGDFN,DGDEPNAM,DGIEN13)=DGPATSSN_"^"_DGREL_"^"_DGDEPSSN_"^"_DGREASON
+27 SET ^TMP("DGEVC",$JOB,"COUNT")=DGC
+28 SET ^TMP("DGEVC",$JOB,"COUNT",DGREASON)=$GET(^TMP("DGEVC",$JOB,"COUNT",DGREASON))+1
+29 KILL DGARR,DGDFN,DGERR,DGDEPNAM,DGDEPSSN,DGPATNAM,DGPATSSN,DGREASON,DGREL
+30 QUIT
HDR2 ;
+1 ;display veteran, non-vet or both
NEW DGDATE,DGL,DGLINE,DGT,Y
+2 IF $EXTRACT(IOST,1,2)["C-"
WRITE @IOF
+3 SET DGPAGE=DGPAGE+1
+4 WRITE !?((IOM-46)\2),"Pseudo SSN Report for Means Test Dependents",?70,"Page:"_DGPAGE
+5 SET DGT="Report shows "_$SELECT(DGXREAS="NULL":"<NONE ENTERED>",1:DGXREAS)
+6 SET DGL=$LENGTH(DGT)
+7 WRITE !?((IOM-DGL)\2),DGT
+8 SET Y=DT
XECUTE ^DD("DD")
SET DGDATE=Y
+9 WRITE !?62,"Date: "_$GET(DGDATE)
+10 WRITE !!,"PATIENT",?27,"PATIENT SSN"
+11 WRITE !?5,"DEPENDENT",?38,"RELATIONSHIP",?52,"DEP. PSSN",?64,"PSSN REASON"
+12 NEW DGZ
+13 WRITE !
+14 FOR DGZ=1:1:IOM
WRITE "-"
+15 QUIT
REP2(DGXREAS) ;
+1 NEW DG0,DGCT,DGDNAM,DGIEN,DGN,DGPNAM,DGRR
+2 SET (DGDNAM,DGN,DGDFN,DGPNAM)=""
+3 SET DGCT=0
+4 FOR
SET DGPNAM=$ORDER(^TMP("DGEVC",$JOB,DGPNAM))
if DGPNAM']""!($GET(DGQ))
QUIT
Begin DoDot:1
+5 IF DGPNAM="COUNT"
IF ($ORDER(^TMP("DGEVC",$JOB,DGPNAM,""))'>0)
QUIT
+6 FOR
SET DGDFN=$ORDER(^TMP("DGEVC",$JOB,DGPNAM,DGDFN))
if DGDFN'>0!($GET(DGQ))
QUIT
Begin DoDot:2
+7 NEW DG0
+8 IF $EXTRACT(IOST,1,2)["C-"
IF ($Y>(IOSL-4))
DO PAUSE^DGPSEUDO
if $GET(DGQ)
QUIT
+9 IF $Y>(IOSL-4)
Begin DoDot:3
+10 WRITE @IOF
+11 DO HDR2
End DoDot:3
+12 SET DG0=^DPT(DGDFN,0)
+13 SET DGSSN=$PIECE(DG0,U,9)
+14 WRITE !!,$EXTRACT($GET(DGPNAM),1,25),?27,$GET(DGSSN)
+15 SET (DGDNAM,DGIEN)=""
+16 FOR
SET DGDNAM=$ORDER(^TMP("DGEVC",$JOB,DGPNAM,DGDFN,DGDNAM))
if DGDNAM']""!($GET(DGQ))
QUIT
Begin DoDot:3
+17 FOR
SET DGIEN=$ORDER(^TMP("DGEVC",$JOB,DGPNAM,DGDFN,DGDNAM,DGIEN))
if DGIEN'>0!($GET(DGQ))
QUIT
Begin DoDot:4
+18 SET DGN=^TMP("DGEVC",$JOB,DGPNAM,DGDFN,DGDNAM,DGIEN)
+19 SET DGRR=$PIECE(DGN,U,4)
+20 SET DGRR=$SELECT(DGRR["REF":"REF TO PROVIDE",DGRR["UNKN":"SSN UNK-F/U REQ",DGRR["NULL":"<NONE ENTERED>",1:DGRR)
+21 IF $EXTRACT(IOST,1,2)["C-"
IF ($Y>(IOSL-4))
DO PAUSE^DGPSEUDO
if $GET(DGQ)
QUIT
+22 IF $Y>(IOSL-4)
Begin DoDot:5
+23 WRITE @IOF
+24 DO HDR2
+25 WRITE !,$EXTRACT($GET(DGPNAM),1,25),?27,$GET(DGSSN)
End DoDot:5
+26 WRITE !?5,$GET(DGDNAM),?38,$EXTRACT($PIECE(DGN,U,2),1,12),?52,$PIECE(DGN,U,3),?64,$GET(DGRR)
+27 SET DGCT=DGCT+1
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+28 IF DGCT=DGC
Begin DoDot:1
+29 IF $EXTRACT(IOST,1,2)["C-"
IF ($Y>(IOSL-6))
DO PAUSE^DGPSEUDO
if $GET(DGQ)
QUIT
+30 IF $Y>(IOSL-6)
Begin DoDot:2
+31 WRITE @IOF
+32 DO HDR2
End DoDot:2
+33 WRITE !!?5,"Total number of dependents with Pseudo SSNs for this report: "_DGC
+34 IF DGXREAS="ALL"
Begin DoDot:2
+35 WRITE !?31,"Dependents who REFUSED TO PROVIDE: "_^TMP("DGEVC",$JOB,"COUNT","REFUSED TO PROVIDE")
+36 WRITE !?29,"Dependents who have NO SSN ASSIGNED: "_^TMP("DGEVC",$JOB,"COUNT","NO SSN ASSIGNED")
+37 WRITE !?33,"Dependents who have SSN UNKNOWN: "_^TMP("DGEVC",$JOB,"COUNT","SSN UNKNOWN/FOLLOW-UP REQUIRED")
+38 WRITE !?22,"Dependents who have no PSSN Reason entered: "_^TMP("DGEVC",$JOB,"COUNT","NULL")
End DoDot:2
End DoDot:1
+39 WRITE !
+40 IF $EXTRACT(IOST,1,2)["C-"
IF ('$GET(DGQ))
DO PAUSE^DGPSEUDO
+41 DO ^%ZISC
DO HOME^%ZIS
+42 QUIT
GETREL(DGREL) ;some relationships will need to be abbreviated to fit the 12
+1 ; char spacing limit
+2 IF DGREL']""
QUIT DGREL
+3 IF $PIECE(DGREL,"-")="GREAT"
SET $PIECE(DGREL,"-")="GR"
+4 QUIT DGREL
