Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DGPSEUDO

DGPSEUDO.m

Go to the documentation of this file. 
  1. DGPSEUDO ;ALB/ERC - REPORTS FOR PSEUDO SSN ; 1/17/06 9:58am
  1.  ;;5.3;Registration;**653**;Aug 13, 1993;Build 2
  1.  ;
  1.  ;creates a report of all patients with pseudo SSNs
  1.  ;can call for veteran, non-veterans or both
  1.  ;can call for one Pseudo SSN Reason or can call for all reasons
  1.  ;sorted by reason
  1. TSK1 ;
  1.  N DGQUIT,DGREAS,DGREASON,DGTXT,DGQ,DGVET,DGXREAS,DGXVET
  1.  N ZTRTN,ZTDESC,ZTSK,ZTIO,ZTDTH,POP,IO,IOBS,IOF,IOHG,IOM,ION,IOPAR
  1.  N IOS,IOSL,IOST,IOT,IOUPAR,IOXY,%ZIS,ZTSAVE
  1.  K ^TMP("DGEVC",$J)
  1.  S DGQUIT=0
  1.  D QUESVET Q:DGQUIT
  1.  D QUESREAS Q:DGQUIT
  1.  S %ZIS="Q" D ^%ZIS I $G(POP) D ^%ZISC,HOME^%ZIS W !,"Job Terminated!" Q
  1.  I $D(IO("Q")) D  Q
  1.  . S ZTRTN="RPT1^DGPSEUDO"
  1.  . S ZTDESC="PATIENTS WITH PSEUDO SOCIAL SECURITY NUMBERS"
  1.  . S (ZTSAVE("DGXREAS"),ZTSAVE("DGXVET"))=""
  1.  . D ^%ZTLOAD
  1.  . S DGTXT=$S($G(ZTSK):"Task: "_ZTSK_" Queued.",1:"Error: Process not queued!")
  1.  . W !,DGTXT
  1. RPT1 ;
  1.  N DGC,DGPAGE,DGXXVET
  1.  S DGPAGE=0
  1.  S DGC=0
  1.  S DGXXVET=DGXVET
  1.  D LOOP1
  1.  D HDR1
  1.  I $G(DGC)'>0 W !!?25,"****NO RECORDS TO REPORT****" W ! D PAUSE Q
  1.  D REP1(DGXVET,DGXREAS)
  1.  D ^%ZISC,HOME^%ZIS
  1.  K ^TMP("DGEVC",$J)
  1.  Q
  1. QUESVET ;ask user if report should be veterans, non-veterans, or both
  1.  N DGBOTH,DIR,DIRUT,DIROUT,X
  1.  W !!!,?10,"REPORT OF PATIENTS WITH PSEUDO SOCIAL SECURITY NUMBERS"
  1.  W !?5,"This report excludes deceased patients, non-user enrollees and"
  1.  W !?5,"with no Integration Control Numbers (ICN).",!
  1.  S DIR("A",1)="Do you want this report for Veterans, Non-Veterans or both?"
  1.  S DIR("A",2)="1. Veterans only"
  1.  S DIR("A",3)="2. Non-Veterans only"
  1.  S DIR("A",4)="3. Veterans and Non-Veterans"
  1.  S DIR("A")="Select"
  1.  S DIR("B")=1
  1.  S DIR("?")="Choose a report with Veterans only, Non-Veterans only or both."
  1.  S DIR(0)="N^1:3"
  1.  D ^DIR
  1.  I $D(DIRUT)!($D(DIROUT)) S DGQUIT=1
  1.  S DGXVET=$S(X=1:"VET",X=2:"NON",1:"BOTH")
  1.  Q
  1.  ;
  1. QUESREAS ;ask user which Pseudo SSN Reason, or all
  1.  N DIR,DIRUT,DIROUT,X
  1.  W !
  1.  S DIR("A",1)="Select which Pseudo SSN Reason(s) to be included in the report."
  1.  S DIR("A",2)="1. Refused to Provide"
  1.  S DIR("A",3)="2. SSN Unknown/Follow-up Required"
  1.  S DIR("A",4)="3. No SSN Assigned"
  1.  S DIR("A",5)="4. No reason on file"
  1.  S DIR("A",6)="5. All of the above"
  1.  S DIR("A")="Select"
  1.  S DIR("?")="Select one of the Reasons for having a Pseudo SSN."
  1.  S DIR(0)="N^1:5"
  1.  D ^DIR
  1.  I $D(DIRUT)!($D(DIROUT)) S DGQUIT=1
  1.  S DGXREAS=$S(X=1:"REFUSED TO PROVIDE",X=2:"SSN UNKNOWN/FOLLOW-UP REQUIRED",X=3:"NO SSN ASSIGNED",X=4:"NULL",1:"ALL")
  1.  Q
  1. LOOP1 ;
  1.  I $E(IOST,1,2)["C-" U IO(0) W !!,"Scanning file...."
  1.  U IO
  1.  N DGDFN,DGX
  1.  K ^TMP("DGEVC",$J)
  1.  S ^TMP("DGEVC",$J,"COUNT","VET","REFUSED TO PROVIDE")=0
  1.  S ^TMP("DGEVC",$J,"COUNT","VET","SSN UNKNOWN/FOLLOW-UP REQUIRED")=0
  1.  S ^TMP("DGEVC",$J,"COUNT","VET","NO SSN ASSIGNED")=0
  1.  S ^TMP("DGEVC",$J,"COUNT","VET","NULL")=0
  1.  S ^TMP("DGEVC",$J,"COUNT","NON","REFUSED TO PROVIDE")=0
  1.  S ^TMP("DGEVC",$J,"COUNT","NON","SSN UNKNOWN/FOLLOW-UP REQUIRED")=0
  1.  S ^TMP("DGEVC",$J,"COUNT","NON","NO SSN ASSIGNED")=0
  1.  S ^TMP("DGEVC",$J,"COUNT","NON","NULL")=0
  1.  S DGX=999999999
  1.  F  S DGX=$O(^DPT("SSN",DGX)) Q:DGX=""  D
  1.  . I DGX'["P" Q
  1.  . S DGDFN=""
  1.  . F  S DGDFN=$O(^DPT("SSN",DGX,DGDFN)) Q:'DGDFN  D
  1.  . . I '$D(^DPT(DGDFN,0)) Q
  1.  . . D PSEU1
  1.  Q
  1. PSEU1 ;
  1.  N DGARR,DGDOB,DGEC,DGERR,DGNAM,DGREASON,DGSSN,DGUSER,DGVET
  1.  I $D(^TMP("DGEVC",$J,DGDFN)) Q
  1.  D GETS^DIQ(2,DGDFN_",",".01;.03;.09;.0906;.351;.361;.3617;991.01;1901","EI","DGARR","DGERR")
  1.  I $D(DGERR) K DGERR Q
  1.  I $G(DGARR(2,DGDFN_",",.351,"I"))]"" K DGARR Q
  1.  I $G(DGARR(2,DGDFN_",",991.01,"I"))']"" K DGARR Q
  1.  S DGVET=$S($G(DGARR(2,DGDFN_",",1901,"I"))="Y":"VET",$G(DGARR(2,DGDFN_",",1901,"I"))="N":"NON",1:"NON")
  1.  I $G(DGVET)]"",DGXVET'="BOTH",DGVET'=DGXVET K DGARR Q
  1.  S DGREASON=$G(DGARR(2,DGDFN_",",.0906,"E"))
  1.  I $G(DGREASON)']"" S DGREASON="NULL"
  1.  I DGXREAS'="ALL",DGXREAS'=DGREASON K DGARR Q
  1.  S DGUSER=$G(DGARR(2,DGDFN_",",.3617,"I"))
  1.  I DGVET="YES",($G(DGUSER)']"") K DGARR Q
  1.  S DGUSER=$$FY($E(DGUSER,1,3)+1700)
  1.  I DGVET="VET",$G(DGUSER)'=1 K DGARR Q
  1.  S DGNAM=$G(DGARR(2,DGDFN_",",.01,"I"))
  1.  I $G(DGNAM)']"" K DGARR Q
  1.  S DGDOB=$G(DGARR(2,DGDFN_",",.03,"E"))
  1.  S DGEC=$G(DGARR(2,DGDFN_",",.361,"E"))
  1.  S DGSSN=DGARR(2,DGDFN_",",.09,"I")
  1.  I DGX'=DGSSN K DGARR Q
  1.  S DGC=DGC+1
  1.  S ^TMP("DGEVC",$J,DGVET,DGREASON,DGNAM,DGDFN)=$G(DGSSN)_"^"_$G(DGDOB)_"^"_$G(DGEC)
  1.  S ^TMP("DGEVC",$J,"COUNT")=DGC
  1.  S ^TMP("DGEVC",$J,"COUNT",DGVET,DGREASON)=$G(^TMP("DGEVC",$J,"COUNT",DGVET,DGREASON))+1
  1.  Q
  1. FY(DGFY) ;determine if user enrollee date is current FY or later
  1.  N DGYEAR
  1.  S DGYEAR=$E(DT,1,3)+1700
  1.  I $E(DT,4,5)>9 S DGYEAR=DGYEAR+1
  1.  Q $S(DGFY>DGYEAR:1,DGFY=DGYEAR:1,1:0)
  1. HDR1 ;
  1.  N DGDATE,DGL,DGLINE,DGT,Y ;display veteran, non-vet or both
  1.  I $E(IOST,1,2)["C-" W @IOF
  1.  S DGPAGE=DGPAGE+1
  1.  W !?((IOM-44)\2),"Patients with Pseudo Social Security Numbers",?70,"Page:"_DGPAGE
  1.  S DGT=$S(DGXXVET="VET":"Veterans only",DGXXVET="NON":"Non-Veterans only",1:"Veterans and Non-Veterans")
  1.  S DGT="Report shows "_DGT
  1.  S DGL=$L(DGT)
  1.  W !?((IOM-DGL)\2),DGT
  1.  S Y=DT X ^DD("DD") S DGDATE=Y
  1.  W !?62,"Date: "_$G(DGDATE)
  1.  W !!,"PATIENT",?32,"PSEUDO SSN",?44,"BIRTHDATE",?56,"PRIMARY ELIGIBILITY CODE"
  1.  N DGZ
  1.  W !
  1.  F DGZ=1:1:IOM W "-" ;S $P(DGLINE,"-",DGZ)=""
  1.  Q
  1. REP1(DGXVET,DGXREAS) ;
  1.  N DGCT,DGV
  1.  S DGCT=0
  1.  I DGXVET="BOTH" D
  1.  . F DGV="VET","NON" D
  1.  . . Q:'$D(^TMP("DGEVC",$J,DGV))
  1.  . . Q:$G(DGQ)
  1.  . . I $E(IOST,1,2)["C-",($Y>(IOSL-4)) D PAUSE Q:$G(DGQ)
  1.  . . I $Y>(IOSL-4) D
  1.  . . . W @IOF
  1.  . . . D HDR1
  1.  . . W !!?5,"Report for "_$S(DGV="VET":"Veterans",1:"Non-Veterans")
  1.  . . D VET(DGV)
  1.  I DGXVET'="BOTH" D VET(DGXVET)
  1.  I $G(DGC)=DGCT W !!?29,"Patients with Pseudo SSNs: "_DGCT
  1.  I $E(IOST,1,2)["C-",('$G(DGQ)) W ! D PAUSE
  1.  Q
  1. VET(DGXVET) ;
  1.  N DGR
  1.  I DGXREAS="ALL" D
  1.  . F DGR="REFUSED TO PROVIDE","SSN UNKNOWN/FOLLOW-UP REQUIRED","NO SSN ASSIGNED","NULL" D
  1.  . . Q:$G(DGQ)
  1.  . . D REAS(DGXVET,DGR)
  1.  I DGXREAS'="ALL" D
  1.  . D REAS(DGXVET,DGXREAS)
  1.  Q
  1. REAS(DGXVET,DGXRR) ;
  1.  N DGN,DGNAM,DGDFN
  1.  S DGDFN=0
  1.  I $E(IOST,1,2)["C-",($Y>(IOSL-4)) D PAUSE Q:$G(DGQ)
  1.  I $Y>(IOSL-4) D
  1.  . W @IOF
  1.  . D HDR1
  1.  I $O(^TMP("DGEVC",$J,DGXVET,DGXRR,""))]"" W !!?10,"Pseudo SSN Reason: "_$S(DGXRR="NULL":"<NONE ENTERED>",1:DGXRR)
  1.  S DGNAM=""
  1.  F  S DGNAM=$O(^TMP("DGEVC",$J,DGXVET,DGXRR,DGNAM)) Q:DGNAM']""!($G(DGQ))  D
  1.  . F  S DGDFN=$O(^TMP("DGEVC",$J,DGXVET,DGXRR,DGNAM,DGDFN)) Q:DGDFN']""!($G(DGQ))  D
  1.  . . I $E(IOST,1,2)["C-",($Y>(IOSL-4)) D PAUSE Q:$G(DGQ)
  1.  . . I $Y>(IOSL-4) D
  1.  . . . W @IOF
  1.  . . . D HDR1
  1.  . . S DGN=^TMP("DGEVC",$J,DGXVET,DGXRR,DGNAM,DGDFN)
  1.  . . W !,DGNAM,?32,$P(DGN,U),?44,$P(DGN,U,2)
  1.  . . I $P(DGN,U,3)["SERVICE CONNECTED" S $P(DGN,U,3)="SC 50% TO 100%"
  1.  . . W ?56,$E($P(DGN,U,3),1,23)
  1.  . . S DGCT=$G(DGCT)+1
  1.  I ^TMP("DGEVC",$J,"COUNT",DGXVET,DGXRR)>0,(DGXREAS="ALL") W !?46,"Subtotal: "_^TMP("DGEVC",$J,"COUNT",DGXVET,DGXRR)
  1.  Q
  1.  ;
  1. PAUSE ;
  1.  N DIR,X,Y
  1.  S DGQ=0
  1.  S DIR(0)="E"
  1.  D ^DIR
  1.  I '+Y!($D(DIRUT)) S DGQ=1
  1.  Q
  1.  ;