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

DGMTDD1.m

Go to the documentation of this file.
  1. DGMTDD1 ;ALB/MIR,JAN,AEG,ERC,BAJ - DD calls from income screening files ; 12/8/06 3:35pm
  1. ;;5.3;PIMS;**180,313,345,401,653,688,1015,1016**;JUN 30, 2012;Build 20
  1. ;
  1. ; This routine contains miscellaneous input transform and other DD
  1. ; calls from income screening files.
  1. ;
  1. ;
  1. SSN ; called from the input transform of the SSN field in file 408.13
  1. N %,L,DGN,DGPAT,PATNAME,PREVX,KANS
  1. ;with DG*5.3*653 Pseudo SSNs will be allowed for spouse/dependents
  1. I X'?9N&(X'?3N1"-"2N1"-"4N)&(X'?9N1"P")&(X'?3N1"-"2N1"-"4N1"P"),(X'?1"P")&(X'?1"p") W !,"Response must be either nine numbers, be in the format nnn-nn-nnnn",!,"or include a ""P"" for a Pseudo SSN." K X Q
  1. I X="P"!(X="p") D PSEU S X=L K L G SSNQ
  1. I X["P" D PSEU I X'=L K X,L W !!,$C(7),"Invalid Pseudo SSN, type ""P"" for valid one." Q
  1. I X["P" G SSNQ
  1. I X'?.AN F %=1:1:$L(X) I $E(X,%)?1P S X=$E(X,0,%-1)_$E(X,%+1,999),%=%-1
  1. I X'?9N K X Q
  1. I $D(X) S L=$E(X,1) I L=9 W !,*7,"The SSN must not begin with 9." K X Q
  1. I $D(X),$E(X,1,3)="000" W !,*7,"First three digits cannot be zeros." K X Q
  1. ;
  1. ; warning if the spouse's/dependent's SSN is found in the PATIENT file
  1. ; and spouse/dependent is not a veteran. spouse/dependent is a veteran
  1. ; if name, sex, DOB match.
  1. ;
  1. ; input (OPTIONAL)
  1. ; ANS(.01) = NAME, ANS(.02) = SEX, ANS(.03) = DOB
  1. ;
  1. ; if newly entered values (those not yet committed to dbase) not
  1. ; supplied then pull current detail from the Person Income file
  1. ; (#408.13) for this dependent.
  1. I '$G(ANS(.01)),'$G(ANS(.02)),'$G(ANS(.03)) D
  1. . N REC,FLD
  1. . D GETS^DIQ(408.13,DA,".01;.02;.03","I","REC")
  1. . F FLD=".01",".02",".03" S ANS(FLD)=REC(408.13,DA_",",FLD,"I")
  1. . S KANS=1
  1. E S KANS=0
  1. ;
  1. S DGN=$O(^DPT("SSN",X,0)) G:'DGN SSDEP S DGPAT=$G(^DPT(DGN,0))
  1. I $P(DGPAT,"^",3)=ANS(.03),($P(DGPAT,"^",2)=ANS(.02)),($P(DGPAT,"^")=ANS(.01)) G SSDEP
  1. S PATNAME=$P(DGPAT,"^") D WARN Q
  1. ;
  1. SSDEP ; warning if spouse's/dependent's SSN is found in file 408.13 and
  1. ; name, sex, DOB don't match
  1. S DGN=$O(^DGPR(408.13,"SSN",X,0)) G:'DGN SSNQ S DGPAT=$G(^DGPR(408.13,DGN,0))
  1. I $P(DGPAT,"^",3)=ANS(.03),($P(DGPAT,"^",2)=ANS(.02)),($P(DGPAT,"^")=ANS(.01)) G SSNQ
  1. S PATNAME=$P($G(^DGPR(408.13,DGN,0)),"^") D WARN Q
  1. ;
  1. SSNQ K:KANS ANS Q
  1. ;
  1. ;
  1. PSEU ;create a Pseudo SSN using same algorithm as file 2 in PSEU^DGRPDD1
  1. S KANS=""
  1. I $G(ANS(.01))']""!($G(ANS(.03))'?7N) D
  1. . S DGNODE0=^DGPR(408.13,DA,0)
  1. . S ANS(.01)=$P(DGNODE0,U),ANS(.03)=$P(DGNODE0,U,3)
  1. I $D(ANS(.01)) S NAM=ANS(.01)
  1. I $D(ANS(.03)) S DOB=ANS(.03)
  1. I $G(DOB)="" S DOB=2000000
  1. S L1=$E($P(NAM," ",2)),L3=$E(NAM),NAM=$P(NAM,",",2),L2=$E(NAM)
  1. S Z=L1 D CON S L1=Z
  1. S Z=L2 D CON S L2=Z
  1. S Z=L3 D CON S L3=Z
  1. S L=L2_L1_L3_$E(DOB,4,7)_$E(DOB,2,3)_"P"
  1. Q
  1. CON ;
  1. S Z=$A(Z)-65\3+1 S:Z<0 Z=0
  1. Q
  1. ;
  1. WARN ; printed WARNING message to alert user that spouse/dependent SSN be
  1. ; that of a veteran in Patient/Income Person File.
  1. W !,*7,"Warning - ",X," belongs to patient ",PATNAME
  1. K DIR S PREVX=X,DIR(0)="YA",DIR("A")="Are you sure this is the correct SSN? ",DIR("B")="YES" D ^DIR
  1. I Y=1 S X=PREVX K PREVX,DIR("B") Q
  1. E K DIR("B"),X Q
  1. ;
  1. REL ; called from the input transform of the RELATIONSHIP field of file 408.12...sets DIC("S")
  1. N DGNODE,DGX,SEX
  1. S DGNODE=$G(^DGPR(408.12,DA,0)),DGX=$P(DGNODE,"^",2) Q:'DGNODE
  1. I DGX,(DGX<3) S DIC("S")="I Y="_DGX Q
  1. S DGX=$P(DGNODE,"^",3),SEX=$P($G(@("^"_$P(DGX,";",2)_+DGX_",0)")),"^",2)
  1. S DIC("S")="I Y>2,(""E"_SEX_"""[$P(^(0),""^"",3))"
  1. I $P(DGNODE,U,2)>6 I $$CNTDEPS^DGMTU11(+DGNODE)>18 S DIC("S")=DIC("S")_",(Y>6)"
  1. I $D(DGTYPE),DGTYPE="C" S DIC("S")=DIC("S")_",(Y<7)"
  1. Q