- DGDEP1 ;ALB/CAW,BAJ,ERC - List One Dependent/Edit Effective Dates ; 8/1/08 1:10pm
- ;;5.3;Registration;**45,60,624,653,688**;Aug 13, 1993;Build 29
- ;
- LSTDEP(DGDEP) ;List Dependents
- N DEP,CNT S CNT=0
- F S CNT=$O(DGDEP(CNT)) Q:'CNT D ONE(CNT)
- Q
- ;
- ONE(CNT) ; List one dependent
- ; Modified for SSN VERFICIATION STATUS DG*5.3*688 BAJ 11/22/2005
- ;
- N DGLN S DGLN=1
- ;
- S X="",X=$$SETSTR^VALM1("DOB: ",X,5,5)
- S X=$$SETSTR^VALM1($P(DGDEP(CNT),U,4),X,10,14)
- S X=$$SETSTR^VALM1("Sex: ",X,30,5)
- S X=$$SETSTR^VALM1($P(DGDEP(CNT),U,3),X,35,8)
- S X=$$SETSTR^VALM1("SSN: ",X,52,5)
- S X=$$SETSTR^VALM1($P(DGDEP(CNT),U,5),X,57,14)
- ; Retrieve SSN VERIFICATION STATUS FROM ARRAY
- S X=$$SETSTR^VALM1($P(DGDEP(CNT),U,9),X,71,8)
- D SET(X)
- ;
- ;* Output Spouse' Maiden Name, if defined (DG*5.3*624)
- S X=""
- I $P($G(DGDEP(CNT)),U,2)="SPOUSE" DO
- . N DGMNTEXT
- . S X=$$SETSTR^VALM1("Maiden: ",X,2,8)
- . S DGMNTEXT=$P($G(DGDEP(CNT,"MNADD")),U,1)
- . S:DGMNTEXT]"" X=$$SETSTR^VALM1(DGMNTEXT,X,10,30)
- . S:DGMNTEXT']"" X=$$SETSTR^VALM1("UNANSWERED",X,10,10)
- ;display PSSN Reason if SSN is a pseudo - DG*5.3*653
- I $P($G(DGDEP(CNT)),U,2)'="SELF",($P(DGDEP(CNT),U,5)["P") D
- . S X=$$SETSTR^VALM1("PSSN Reason: ",X,44,15)
- . I $P(DGDEP(CNT),U,10)["Unk" S $P(DGDEP(CNT),U,10)="SSN Unkn/Follow-up Req"
- . S X=$$SETSTR^VALM1($P(DGDEP(CNT),U,10),X,57,22)
- D SET(X)
- S DEP=""
- F S DEP=$O(DGDEP(CNT,DEP)) Q:DEP']"" D
- .I DEP'="MNADD" DO
- ..S X="",X=$$SETSTR^VALM1("Status: ",X,2,8)
- ..S X=$$SETSTR^VALM1($P(DGDEP(CNT,DEP),U,2),X,10,24)
- ..S X=$$SETSTR^VALM1("Effective Date: ",X,41,15)
- ..S X=$$SETSTR^VALM1($P(DGDEP(CNT,DEP),U),X,57,20)
- ..D SET(X)
- ..I $P(DGDEP(CNT,DEP),U,3) D
- ...S X="",X=$$SETSTR^VALM1("Filed by IVM: ",X,43,14)
- ...S X=$$SETSTR^VALM1("Yes",X,57,20)
- ...D SET(X)
- ..D SET("")
- S VALMCNT=DGLN-1
- ;
- S X=""
- S X=$$SETSTR^VALM1("Address: ",X,1,9)
- S:($P($G(DGDEP(CNT,"MNADD")),U,2,7)="^^^^^") X=$$SETSTR^VALM1("UNANSWERED",X,10,10)
- S:($P($G(DGDEP(CNT,"MNADD")),U,2,7)'="^^^^^") X=$$SETSTR^VALM1($P($G(DGDEP(CNT,"MNADD")),U,2),X,10,35)
- S X=$$SETSTR^VALM1("Phone: ",X,50,7)
- S:($P($G(DGDEP(CNT,"MNADD")),U,8)="") X=$$SETSTR^VALM1("UNANSWERED",X,57,10)
- S:($P($G(DGDEP(CNT,"MNADD")),U,8)'="") X=$$SETSTR^VALM1($P($G(DGDEP(CNT,"MNADD")),U,8),X,57,13)
- D SET(X)
- ;
- ;* Output dependent address (DG*5.3*624)
- I ($P($G(DGDEP(CNT,"MNADD")),U,2,7)'="^^^^^") DO
- .S X=""
- .S:($P($G(DGDEP(CNT,"MNADD")),U,3)'="") X=$$SETSTR^VALM1($P($G(DGDEP(CNT,"MNADD")),U,3),X,10,30)
- .S:($P($G(DGDEP(CNT,"MNADD")),U,3)="") X=$$SETSTR^VALM1(" ",X,10,1)
- .D SET(X)
- .S X=""
- .S:($P($G(DGDEP(CNT,"MNADD")),U,4)'="") X=$$SETSTR^VALM1($P($G(DGDEP(CNT,"MNADD")),U,4),X,10,30)
- .S:($P($G(DGDEP(CNT,"MNADD")),U,4)="") X=$$SETSTR^VALM1(" ",X,10,1)
- .D SET(X)
- .S X=""
- .I ($P($G(DGDEP(CNT,"MNADD")),U,5)'="") DO
- ..S X=$$SETSTR^VALM1($P($G(DGDEP(CNT,"MNADD")),U,5),X,10,30)
- ..S X=$$SETSTR^VALM1(",",X,($L($P($G(DGDEP(CNT,"MNADD")),U,5))+10),1)
- .S:($P($G(DGDEP(CNT,"MNADD")),U,5)="") X=$$SETSTR^VALM1(" ",X,10,1)
- .N STATVAL,ZIPPOS
- .S STATVAL=""
- .I ($P($G(DGDEP(CNT,"MNADD")),U,6)'="") DO
- ..S STATVAL=$P(^DIC(5,$P($G(DGDEP(CNT,"MNADD")),U,6),0),"^",1)
- ..S X=$$SETSTR^VALM1(STATVAL,X,($L($P($G(DGDEP(CNT,"MNADD")),U,5))+12),30)
- .S:($P($G(DGDEP(CNT,"MNADD")),U,6)="") X=$$SETSTR^VALM1(" ",X,41,1)
- .;;D SET(X)
- .;;S X=""
- .I ($P($G(DGDEP(CNT,"MNADD")),U,7)'="") DO
- ..S ZIPPOS=($L($P($G(DGDEP(CNT,"MNADD")),U,5))+($L(STATVAL))+14)
- ..S X=$$SETSTR^VALM1($P($G(DGDEP(CNT,"MNADD")),U,7),X,ZIPPOS,10)
- .S:($P($G(DGDEP(CNT,"MNADD")),U,7)="") X=$$SETSTR^VALM1(" ",X,20,1)
- .D SET(X)
- ;
- S VALMCNT=DGLN-1
- Q
- ;
- SET(X) ;Set up array
- S ^TMP("DGMTEP",$J,DGLN,0)=X
- S DGLN=DGLN+1
- Q
- ;
- EXIT ;
- K ^TMP("DGMTEP",$J)
- Q
- ;
- EN ; Effective Dates
- S VALMBCK=""
- I $D(DGMTI),$G(DGMTACT)="VEW" W !,"Cannot edit when viewing a means test." H 2 G ENQ
- I '$D(DGMTI),$G(DGRPV)=1 W !,"Not while viewing" H 2 G ENQ
- D EDIT
- I DGW=1 D I $G(DGERR) W !,"Cannot inactivate veteran" K DGERR G EN
- .S DATE=$O(DGDEP(1,""))
- .S ACTIVE=$P(DGDEP(1,DATE),U,2)
- .I ACTIVE="Inactive" S DGERR=1
- ENQ S VALMBCK="R"
- Q
- ;
- EDIT ; Edit Effective Dates
- ; values for DGFLG:
- ; DGFLG = 1 IVM effective date
- ;
- N DA,DR,DIE,DIC,DATE,DGEDIT,DGEE,Y
- S DGFLG=0,DGEDIT=1
- S DGPR=$S($G(DGW):$P(DGDEP(DGW),U,20),1:$P(DGDEP,U,20))
- S DIE="^DGPR(408.12,",DA=DGPR,DR="75"
- 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"
- D ^DIE
- I DGFLG W !!,"Cannot edit date added by IVM." H 2 G EDITQ
- S DATE=0,DATE=$O(^DGPR(408.12,$P(DGDEP(DGW),U,20),"E",DATE))
- I 'DATE W !!,"There has to be an effective date for this person." H 2 G EDIT
- EDITQ K DGDEP,DGFLG D INIT^DGDEP
- K ^TMP("DGMTEP",$J) D ONE(DGW)
- Q
- ;
- DOB(DA,X) ;CHECK EFFECTIVE DATE AGAINST DOB
- N DGFILE,X1,NODE
- S DGFILE=$P($G(^DGPR(408.12,DA,0)),U,3),X1=$P(DGFILE,";"),DGFILE=$S(DGFILE["DGPR":"^DGPR(408.13,",1:"^DPT(")
- I X<$P($G(@(DGFILE_X1_",0)")),U,3) D Q X
- . W !," <<EFFECTIVE DATE may not precede Date Of Birth>>",*7
- . S X=0
- ;
- S NODE=$G(^DGPR(408.12,DA,0))
- I ($P(NODE,U,2)>1),(X<$P($G(^DPT(+$P(NODE,U),0)),U,3)) D Q 0
- . W !," <<EFFECTIVE DATE may not precede Veteran Date Of Birth>>",$C(7)
- ;
- I $P(NODE,U,2)=2 D I X=0 Q X
- . S X1=+$P($G(^DPT(+$P(NODE,U),.35)),U) ;Vet Date Of Death
- . I (X1>0),(X>X1) D Q
- . . W !," <<EFFECTIVE DATE may not be greater than Veteran Date Of Death>>",$C(7)
- . . S X=0
- . I '$$ACTIVE^DGMTU11(DA,X) D Q ;Only check inactive spouse
- . . W !," <<EFFECTIVE DATE must be a date prior to Spouse Inactivation Date>>",$C(7)
- . . S X=0
- ;
- Q X
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGDEP1 5720 printed Feb 19, 2025@00:07:57 Page 2
- 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
- +2 ;
- LSTDEP(DGDEP) ;List Dependents
- +1 NEW DEP,CNT
- SET CNT=0
- +2 FOR
- SET CNT=$ORDER(DGDEP(CNT))
- if 'CNT
- QUIT
- DO ONE(CNT)
- +3 QUIT
- +4 ;
- ONE(CNT) ; List one dependent
- +1 ; Modified for SSN VERFICIATION STATUS DG*5.3*688 BAJ 11/22/2005
- +2 ;
- +3 NEW DGLN
- SET DGLN=1
- +4 ;
- +5 SET X=""
- SET X=$$SETSTR^VALM1("DOB: ",X,5,5)
- +6 SET X=$$SETSTR^VALM1($PIECE(DGDEP(CNT),U,4),X,10,14)
- +7 SET X=$$SETSTR^VALM1("Sex: ",X,30,5)
- +8 SET X=$$SETSTR^VALM1($PIECE(DGDEP(CNT),U,3),X,35,8)
- +9 SET X=$$SETSTR^VALM1("SSN: ",X,52,5)
- +10 SET X=$$SETSTR^VALM1($PIECE(DGDEP(CNT),U,5),X,57,14)
- +11 ; Retrieve SSN VERIFICATION STATUS FROM ARRAY
- +12 SET X=$$SETSTR^VALM1($PIECE(DGDEP(CNT),U,9),X,71,8)
- +13 DO SET(X)
- +14 ;
- +15 ;* Output Spouse' Maiden Name, if defined (DG*5.3*624)
- +16 SET X=""
- +17 IF $PIECE($GET(DGDEP(CNT)),U,2)="SPOUSE"
- Begin DoDot:1
- +18 NEW DGMNTEXT
- +19 SET X=$$SETSTR^VALM1("Maiden: ",X,2,8)
- +20 SET DGMNTEXT=$PIECE($GET(DGDEP(CNT,"MNADD")),U,1)
- +21 if DGMNTEXT]""
- SET X=$$SETSTR^VALM1(DGMNTEXT,X,10,30)
- +22 if DGMNTEXT']""
- SET X=$$SETSTR^VALM1("UNANSWERED",X,10,10)
- End DoDot:1
- +23 ;display PSSN Reason if SSN is a pseudo - DG*5.3*653
- +24 IF $PIECE($GET(DGDEP(CNT)),U,2)'="SELF"
- IF ($PIECE(DGDEP(CNT),U,5)["P")
- Begin DoDot:1
- +25 SET X=$$SETSTR^VALM1("PSSN Reason: ",X,44,15)
- +26 IF $PIECE(DGDEP(CNT),U,10)["Unk"
- SET $PIECE(DGDEP(CNT),U,10)="SSN Unkn/Follow-up Req"
- +27 SET X=$$SETSTR^VALM1($PIECE(DGDEP(CNT),U,10),X,57,22)
- End DoDot:1
- +28 DO SET(X)
- +29 SET DEP=""
- +30 FOR
- SET DEP=$ORDER(DGDEP(CNT,DEP))
- if DEP']""
- QUIT
- Begin DoDot:1
- +31 IF DEP'="MNADD"
- Begin DoDot:2
- +32 SET X=""
- SET X=$$SETSTR^VALM1("Status: ",X,2,8)
- +33 SET X=$$SETSTR^VALM1($PIECE(DGDEP(CNT,DEP),U,2),X,10,24)
- +34 SET X=$$SETSTR^VALM1("Effective Date: ",X,41,15)
- +35 SET X=$$SETSTR^VALM1($PIECE(DGDEP(CNT,DEP),U),X,57,20)
- +36 DO SET(X)
- +37 IF $PIECE(DGDEP(CNT,DEP),U,3)
- Begin DoDot:3
- +38 SET X=""
- SET X=$$SETSTR^VALM1("Filed by IVM: ",X,43,14)
- +39 SET X=$$SETSTR^VALM1("Yes",X,57,20)
- +40 DO SET(X)
- End DoDot:3
- +41 DO SET("")
- End DoDot:2
- End DoDot:1
- +42 SET VALMCNT=DGLN-1
- +43 ;
- +44 SET X=""
- +45 SET X=$$SETSTR^VALM1("Address: ",X,1,9)
- +46 if ($PIECE($GET(DGDEP(CNT,"MNADD")),U,2,7)="^^^^^")
- SET X=$$SETSTR^VALM1("UNANSWERED",X,10,10)
- +47 if ($PIECE($GET(DGDEP(CNT,"MNADD")),U,2,7)'="^^^^^")
- SET X=$$SETSTR^VALM1($PIECE($GET(DGDEP(CNT,"MNADD")),U,2),X,10,35)
- +48 SET X=$$SETSTR^VALM1("Phone: ",X,50,7)
- +49 if ($PIECE($GET(DGDEP(CNT,"MNADD")),U,8)="")
- SET X=$$SETSTR^VALM1("UNANSWERED",X,57,10)
- +50 if ($PIECE($GET(DGDEP(CNT,"MNADD")),U,8)'="")
- SET X=$$SETSTR^VALM1($PIECE($GET(DGDEP(CNT,"MNADD")),U,8),X,57,13)
- +51 DO SET(X)
- +52 ;
- +53 ;* Output dependent address (DG*5.3*624)
- +54 IF ($PIECE($GET(DGDEP(CNT,"MNADD")),U,2,7)'="^^^^^")
- Begin DoDot:1
- +55 SET X=""
- +56 if ($PIECE($GET(DGDEP(CNT,"MNADD")),U,3)'="")
- SET X=$$SETSTR^VALM1($PIECE($GET(DGDEP(CNT,"MNADD")),U,3),X,10,30)
- +57 if ($PIECE($GET(DGDEP(CNT,"MNADD")),U,3)="")
- SET X=$$SETSTR^VALM1(" ",X,10,1)
- +58 DO SET(X)
- +59 SET X=""
- +60 if ($PIECE($GET(DGDEP(CNT,"MNADD")),U,4)'="")
- SET X=$$SETSTR^VALM1($PIECE($GET(DGDEP(CNT,"MNADD")),U,4),X,10,30)
- +61 if ($PIECE($GET(DGDEP(CNT,"MNADD")),U,4)="")
- SET X=$$SETSTR^VALM1(" ",X,10,1)
- +62 DO SET(X)
- +63 SET X=""
- +64 IF ($PIECE($GET(DGDEP(CNT,"MNADD")),U,5)'="")
- Begin DoDot:2
- +65 SET X=$$SETSTR^VALM1($PIECE($GET(DGDEP(CNT,"MNADD")),U,5),X,10,30)
- +66 SET X=$$SETSTR^VALM1(",",X,($LENGTH($PIECE($GET(DGDEP(CNT,"MNADD")),U,5))+10),1)
- End DoDot:2
- +67 if ($PIECE($GET(DGDEP(CNT,"MNADD")),U,5)="")
- SET X=$$SETSTR^VALM1(" ",X,10,1)
- +68 NEW STATVAL,ZIPPOS
- +69 SET STATVAL=""
- +70 IF ($PIECE($GET(DGDEP(CNT,"MNADD")),U,6)'="")
- Begin DoDot:2
- +71 SET STATVAL=$PIECE(^DIC(5,$PIECE($GET(DGDEP(CNT,"MNADD")),U,6),0),"^",1)
- +72 SET X=$$SETSTR^VALM1(STATVAL,X,($LENGTH($PIECE($GET(DGDEP(CNT,"MNADD")),U,5))+12),30)
- End DoDot:2
- +73 if ($PIECE($GET(DGDEP(CNT,"MNADD")),U,6)="")
- SET X=$$SETSTR^VALM1(" ",X,41,1)
- +74 ;;D SET(X)
- +75 ;;S X=""
- +76 IF ($PIECE($GET(DGDEP(CNT,"MNADD")),U,7)'="")
- Begin DoDot:2
- +77 SET ZIPPOS=($LENGTH($PIECE($GET(DGDEP(CNT,"MNADD")),U,5))+($LENGTH(STATVAL))+14)
- +78 SET X=$$SETSTR^VALM1($PIECE($GET(DGDEP(CNT,"MNADD")),U,7),X,ZIPPOS,10)
- End DoDot:2
- +79 if ($PIECE($GET(DGDEP(CNT,"MNADD")),U,7)="")
- SET X=$$SETSTR^VALM1(" ",X,20,1)
- +80 DO SET(X)
- End DoDot:1
- +81 ;
- +82 SET VALMCNT=DGLN-1
- +83 QUIT
- +84 ;
- SET(X) ;Set up array
- +1 SET ^TMP("DGMTEP",$JOB,DGLN,0)=X
- +2 SET DGLN=DGLN+1
- +3 QUIT
- +4 ;
- EXIT ;
- +1 KILL ^TMP("DGMTEP",$JOB)
- +2 QUIT
- +3 ;
- EN ; Effective Dates
- +1 SET VALMBCK=""
- +2 IF $DATA(DGMTI)
- IF $GET(DGMTACT)="VEW"
- WRITE !,"Cannot edit when viewing a means test."
- HANG 2
- GOTO ENQ
- +3 IF '$DATA(DGMTI)
- IF $GET(DGRPV)=1
- WRITE !,"Not while viewing"
- HANG 2
- GOTO ENQ
- +4 DO EDIT
- +5 IF DGW=1
- Begin DoDot:1
- +6 SET DATE=$ORDER(DGDEP(1,""))
- +7 SET ACTIVE=$PIECE(DGDEP(1,DATE),U,2)
- +8 IF ACTIVE="Inactive"
- SET DGERR=1
- End DoDot:1
- IF $GET(DGERR)
- WRITE !,"Cannot inactivate veteran"
- KILL DGERR
- GOTO EN
- ENQ SET VALMBCK="R"
- +1 QUIT
- +2 ;
- EDIT ; Edit Effective Dates
- +1 ; values for DGFLG:
- +2 ; DGFLG = 1 IVM effective date
- +3 ;
- +4 NEW DA,DR,DIE,DIC,DATE,DGEDIT,DGEE,Y
- +5 SET DGFLG=0
- SET DGEDIT=1
- +6 SET DGPR=$SELECT($GET(DGW):$PIECE(DGDEP(DGW),U,20),1:$PIECE(DGDEP,U,20))
- +7 SET DIE="^DGPR(408.12,"
- SET DA=DGPR
- SET DR="75"
- +8 SET 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"
- +9 DO ^DIE
- +10 IF DGFLG
- WRITE !!,"Cannot edit date added by IVM."
- HANG 2
- GOTO EDITQ
- +11 SET DATE=0
- SET DATE=$ORDER(^DGPR(408.12,$PIECE(DGDEP(DGW),U,20),"E",DATE))
- +12 IF 'DATE
- WRITE !!,"There has to be an effective date for this person."
- HANG 2
- GOTO EDIT
- EDITQ KILL DGDEP,DGFLG
- DO INIT^DGDEP
- +1 KILL ^TMP("DGMTEP",$JOB)
- DO ONE(DGW)
- +2 QUIT
- +3 ;
- DOB(DA,X) ;CHECK EFFECTIVE DATE AGAINST DOB
- +1 NEW DGFILE,X1,NODE
- +2 SET DGFILE=$PIECE($GET(^DGPR(408.12,DA,0)),U,3)
- SET X1=$PIECE(DGFILE,";")
- SET DGFILE=$SELECT(DGFILE["DGPR":"^DGPR(408.13,",1:"^DPT(")
- +3 IF X<$PIECE($GET(@(DGFILE_X1_",0)")),U,3)
- Begin DoDot:1
- +4 WRITE !," <<EFFECTIVE DATE may not precede Date Of Birth>>",*7
- +5 SET X=0
- End DoDot:1
- QUIT X
- +6 ;
- +7 SET NODE=$GET(^DGPR(408.12,DA,0))
- +8 IF ($PIECE(NODE,U,2)>1)
- IF (X<$PIECE($GET(^DPT(+$PIECE(NODE,U),0)),U,3))
- Begin DoDot:1
- +9 WRITE !," <<EFFECTIVE DATE may not precede Veteran Date Of Birth>>",$CHAR(7)
- End DoDot:1
- QUIT 0
- +10 ;
- +11 IF $PIECE(NODE,U,2)=2
- Begin DoDot:1
- +12 ;Vet Date Of Death
- SET X1=+$PIECE($GET(^DPT(+$PIECE(NODE,U),.35)),U)
- +13 IF (X1>0)
- IF (X>X1)
- Begin DoDot:2
- +14 WRITE !," <<EFFECTIVE DATE may not be greater than Veteran Date Of Death>>",$CHAR(7)
- +15 SET X=0
- End DoDot:2
- QUIT
- +16 ;Only check inactive spouse
- IF '$$ACTIVE^DGMTU11(DA,X)
- Begin DoDot:2
- +17 WRITE !," <<EFFECTIVE DATE must be a date prior to Spouse Inactivation Date>>",$CHAR(7)
- +18 SET X=0
- End DoDot:2
- QUIT
- End DoDot:1
- IF X=0
- QUIT X
- +19 ;
- +20 QUIT X