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

DGDEP1.m

Go to the documentation of this file.
  1. DGDEP1 ;ALB/CAW,BAJ,ERC - List One Dependent/Edit Effective Dates ; 8/1/08 1:10pm
  1. ;;5.3;Registration;**45,60,624,653,688**;Aug 13, 1993;Build 29
  1. ;
  1. LSTDEP(DGDEP) ;List Dependents
  1. N DEP,CNT S CNT=0
  1. F S CNT=$O(DGDEP(CNT)) Q:'CNT D ONE(CNT)
  1. Q
  1. ;
  1. ONE(CNT) ; List one dependent
  1. ; Modified for SSN VERFICIATION STATUS DG*5.3*688 BAJ 11/22/2005
  1. ;
  1. N DGLN S DGLN=1
  1. ;
  1. S X="",X=$$SETSTR^VALM1("DOB: ",X,5,5)
  1. S X=$$SETSTR^VALM1($P(DGDEP(CNT),U,4),X,10,14)
  1. S X=$$SETSTR^VALM1("Sex: ",X,30,5)
  1. S X=$$SETSTR^VALM1($P(DGDEP(CNT),U,3),X,35,8)
  1. S X=$$SETSTR^VALM1("SSN: ",X,52,5)
  1. S X=$$SETSTR^VALM1($P(DGDEP(CNT),U,5),X,57,14)
  1. ; Retrieve SSN VERIFICATION STATUS FROM ARRAY
  1. S X=$$SETSTR^VALM1($P(DGDEP(CNT),U,9),X,71,8)
  1. D SET(X)
  1. ;
  1. ;* Output Spouse' Maiden Name, if defined (DG*5.3*624)
  1. S X=""
  1. I $P($G(DGDEP(CNT)),U,2)="SPOUSE" DO
  1. . N DGMNTEXT
  1. . S X=$$SETSTR^VALM1("Maiden: ",X,2,8)
  1. . S DGMNTEXT=$P($G(DGDEP(CNT,"MNADD")),U,1)
  1. . S:DGMNTEXT]"" X=$$SETSTR^VALM1(DGMNTEXT,X,10,30)
  1. . S:DGMNTEXT']"" X=$$SETSTR^VALM1("UNANSWERED",X,10,10)
  1. ;display PSSN Reason if SSN is a pseudo - DG*5.3*653
  1. I $P($G(DGDEP(CNT)),U,2)'="SELF",($P(DGDEP(CNT),U,5)["P") D
  1. . S X=$$SETSTR^VALM1("PSSN Reason: ",X,44,15)
  1. . I $P(DGDEP(CNT),U,10)["Unk" S $P(DGDEP(CNT),U,10)="SSN Unkn/Follow-up Req"
  1. . S X=$$SETSTR^VALM1($P(DGDEP(CNT),U,10),X,57,22)
  1. D SET(X)
  1. S DEP=""
  1. F S DEP=$O(DGDEP(CNT,DEP)) Q:DEP']"" D
  1. .I DEP'="MNADD" DO
  1. ..S X="",X=$$SETSTR^VALM1("Status: ",X,2,8)
  1. ..S X=$$SETSTR^VALM1($P(DGDEP(CNT,DEP),U,2),X,10,24)
  1. ..S X=$$SETSTR^VALM1("Effective Date: ",X,41,15)
  1. ..S X=$$SETSTR^VALM1($P(DGDEP(CNT,DEP),U),X,57,20)
  1. ..D SET(X)
  1. ..I $P(DGDEP(CNT,DEP),U,3) D
  1. ...S X="",X=$$SETSTR^VALM1("Filed by IVM: ",X,43,14)
  1. ...S X=$$SETSTR^VALM1("Yes",X,57,20)
  1. ...D SET(X)
  1. ..D SET("")
  1. S VALMCNT=DGLN-1
  1. ;
  1. S X=""
  1. S X=$$SETSTR^VALM1("Address: ",X,1,9)
  1. S:($P($G(DGDEP(CNT,"MNADD")),U,2,7)="^^^^^") X=$$SETSTR^VALM1("UNANSWERED",X,10,10)
  1. S:($P($G(DGDEP(CNT,"MNADD")),U,2,7)'="^^^^^") X=$$SETSTR^VALM1($P($G(DGDEP(CNT,"MNADD")),U,2),X,10,35)
  1. S X=$$SETSTR^VALM1("Phone: ",X,50,7)
  1. S:($P($G(DGDEP(CNT,"MNADD")),U,8)="") X=$$SETSTR^VALM1("UNANSWERED",X,57,10)
  1. S:($P($G(DGDEP(CNT,"MNADD")),U,8)'="") X=$$SETSTR^VALM1($P($G(DGDEP(CNT,"MNADD")),U,8),X,57,13)
  1. D SET(X)
  1. ;
  1. ;* Output dependent address (DG*5.3*624)
  1. I ($P($G(DGDEP(CNT,"MNADD")),U,2,7)'="^^^^^") DO
  1. .S X=""
  1. .S:($P($G(DGDEP(CNT,"MNADD")),U,3)'="") X=$$SETSTR^VALM1($P($G(DGDEP(CNT,"MNADD")),U,3),X,10,30)
  1. .S:($P($G(DGDEP(CNT,"MNADD")),U,3)="") X=$$SETSTR^VALM1(" ",X,10,1)
  1. .D SET(X)
  1. .S X=""
  1. .S:($P($G(DGDEP(CNT,"MNADD")),U,4)'="") X=$$SETSTR^VALM1($P($G(DGDEP(CNT,"MNADD")),U,4),X,10,30)
  1. .S:($P($G(DGDEP(CNT,"MNADD")),U,4)="") X=$$SETSTR^VALM1(" ",X,10,1)
  1. .D SET(X)
  1. .S X=""
  1. .I ($P($G(DGDEP(CNT,"MNADD")),U,5)'="") DO
  1. ..S X=$$SETSTR^VALM1($P($G(DGDEP(CNT,"MNADD")),U,5),X,10,30)
  1. ..S X=$$SETSTR^VALM1(",",X,($L($P($G(DGDEP(CNT,"MNADD")),U,5))+10),1)
  1. .S:($P($G(DGDEP(CNT,"MNADD")),U,5)="") X=$$SETSTR^VALM1(" ",X,10,1)
  1. .N STATVAL,ZIPPOS
  1. .S STATVAL=""
  1. .I ($P($G(DGDEP(CNT,"MNADD")),U,6)'="") DO
  1. ..S STATVAL=$P(^DIC(5,$P($G(DGDEP(CNT,"MNADD")),U,6),0),"^",1)
  1. ..S X=$$SETSTR^VALM1(STATVAL,X,($L($P($G(DGDEP(CNT,"MNADD")),U,5))+12),30)
  1. .S:($P($G(DGDEP(CNT,"MNADD")),U,6)="") X=$$SETSTR^VALM1(" ",X,41,1)
  1. .;;D SET(X)
  1. .;;S X=""
  1. .I ($P($G(DGDEP(CNT,"MNADD")),U,7)'="") DO
  1. ..S ZIPPOS=($L($P($G(DGDEP(CNT,"MNADD")),U,5))+($L(STATVAL))+14)
  1. ..S X=$$SETSTR^VALM1($P($G(DGDEP(CNT,"MNADD")),U,7),X,ZIPPOS,10)
  1. .S:($P($G(DGDEP(CNT,"MNADD")),U,7)="") X=$$SETSTR^VALM1(" ",X,20,1)
  1. .D SET(X)
  1. ;
  1. S VALMCNT=DGLN-1
  1. Q
  1. ;
  1. SET(X) ;Set up array
  1. S ^TMP("DGMTEP",$J,DGLN,0)=X
  1. S DGLN=DGLN+1
  1. Q
  1. ;
  1. EXIT ;
  1. K ^TMP("DGMTEP",$J)
  1. Q
  1. ;
  1. EN ; Effective Dates
  1. S VALMBCK=""
  1. I $D(DGMTI),$G(DGMTACT)="VEW" W !,"Cannot edit when viewing a means test." H 2 G ENQ
  1. I '$D(DGMTI),$G(DGRPV)=1 W !,"Not while viewing" H 2 G ENQ
  1. D EDIT
  1. I DGW=1 D I $G(DGERR) W !,"Cannot inactivate veteran" K DGERR G EN
  1. .S DATE=$O(DGDEP(1,""))
  1. .S ACTIVE=$P(DGDEP(1,DATE),U,2)
  1. .I ACTIVE="Inactive" S DGERR=1
  1. ENQ S VALMBCK="R"
  1. Q
  1. ;
  1. EDIT ; Edit Effective Dates
  1. ; values for DGFLG:
  1. ; DGFLG = 1 IVM effective date
  1. ;
  1. N DA,DR,DIE,DIC,DATE,DGEDIT,DGEE,Y
  1. S DGFLG=0,DGEDIT=1
  1. S DGPR=$S($G(DGW):$P(DGDEP(DGW),U,20),1:$P(DGDEP,U,20))
  1. S DIE="^DGPR(408.12,",DA=DGPR,DR="75"
  1. S DR(2,408.1275)="I $P($G(^DGPR(408.12,DGPR,""E"",DA,0)),U,3) S Y=0,DGFLG=1;S:$P($G(^DGPR(408.12,DGPR,""E"",DA,0)),U,2)']"""" DIE(""NO^"")="""";.01;.02"
  1. D ^DIE
  1. I DGFLG W !!,"Cannot edit date added by IVM." H 2 G EDITQ
  1. S DATE=0,DATE=$O(^DGPR(408.12,$P(DGDEP(DGW),U,20),"E",DATE))
  1. I 'DATE W !!,"There has to be an effective date for this person." H 2 G EDIT
  1. EDITQ K DGDEP,DGFLG D INIT^DGDEP
  1. K ^TMP("DGMTEP",$J) D ONE(DGW)
  1. Q
  1. ;
  1. DOB(DA,X) ;CHECK EFFECTIVE DATE AGAINST DOB
  1. N DGFILE,X1,NODE
  1. S DGFILE=$P($G(^DGPR(408.12,DA,0)),U,3),X1=$P(DGFILE,";"),DGFILE=$S(DGFILE["DGPR":"^DGPR(408.13,",1:"^DPT(")
  1. I X<$P($G(@(DGFILE_X1_",0)")),U,3) D Q X
  1. . W !," <<EFFECTIVE DATE may not precede Date Of Birth>>",*7
  1. . S X=0
  1. ;
  1. S NODE=$G(^DGPR(408.12,DA,0))
  1. I ($P(NODE,U,2)>1),(X<$P($G(^DPT(+$P(NODE,U),0)),U,3)) D Q 0
  1. . W !," <<EFFECTIVE DATE may not precede Veteran Date Of Birth>>",$C(7)
  1. ;
  1. I $P(NODE,U,2)=2 D I X=0 Q X
  1. . S X1=+$P($G(^DPT(+$P(NODE,U),.35)),U) ;Vet Date Of Death
  1. . I (X1>0),(X>X1) D Q
  1. . . W !," <<EFFECTIVE DATE may not be greater than Veteran Date Of Death>>",$C(7)
  1. . . S X=0
  1. . I '$$ACTIVE^DGMTU11(DA,X) D Q ;Only check inactive spouse
  1. . . W !," <<EFFECTIVE DATE must be a date prior to Spouse Inactivation Date>>",$C(7)
  1. . . S X=0
  1. ;
  1. Q X