DGRP7CP ;ALB/BDB,JAM - REGISTRATION SCREEN 7 EXPANSION FIELDS FOR VBA PENSION;04/21/2011
;;5.3;Registration;**842,1075**;Aug 13, 1993;Build 13
;
EN(DFN,QUIT) ; Display/edit Pension Award and Termination
; Returns QUIT=1 if ^ entered
;
EN1 D CLEAR^VALM1
N DGRP,X,Z,ZP,I,DGMBCK
F I=0,.29,.3,.31,.32,.321,.36,.362,.385,"TYPE","VET" S DGRP(I)=$S($D(^DPT(DFN,I)):^(I),1:"")
D EN^DDIOL(" COMPENSATION AND PENSION, SCREEN <7> EXPANSION","","!")
D EN^DDIOL($$SSNNM^DGRPU(DFN),"","!")
S X=$S($D(DGRPTYPE):$P(DGRPTYPE,"^",1),1:"PATIENT TYPE UNKNOWN"),X1=79-$L(X) D EN^DDIOL(X,"","?X1")
S X="",$P(X,"=",80)="" D EN^DDIOL(X,"","!")
;
; Patch D*5.3*1075 - for the next 3 fields, if value is UNANSWERED/NULL, change it to NO for Non-Veteran
D EN^DDIOL("Aid & Attendance: ","","!!?17")
;S Z=$$YN2^DG1010P0(DGRP(.362),12) D MBCK^DGRP7 D EN^DDIOL(Z,"","?0")
S Z=$$YN2^DG1010P0(DGRP(.362),12)
I Z="UNANSWERED" I $P(DGRP("VET"),U)="N" S Z="NO"
D MBCK^DGRP7 D EN^DDIOL(Z,"","?0")
D EN^DDIOL("Housebound: ","","!?23")
;S Z=$$YN2^DG1010P0(DGRP(.362),13) D MBCK^DGRP7 D EN^DDIOL(Z,"","?0")
S Z=$$YN2^DG1010P0(DGRP(.362),13)
I Z="UNANSWERED" I $P(DGRP("VET"),U)="N" S Z="NO"
D MBCK^DGRP7 D EN^DDIOL(Z,"","?0")
D EN^DDIOL("VA Pension: ","","!?23")
;I $P(DGRP(.362),"^",14)']"" D EN^DDIOL("UNANSWERED","","?0")
I $P(DGRP(.362),"^",14)']"" D
. I $P(DGRP("VET"),U)="N" D EN^DDIOL("NO","","?0")
. I $P(DGRP("VET"),U)'="N" D EN^DDIOL("UNANSWERED","","?0")
;
I $P(DGRP(.362),"^",14)]"" S ZP=$$YN2^DG1010P0(DGRP(.362),14) D MBCK^DGRP7 D EN^DDIOL(ZP,"","?0") D
. I $P(DGRP(.385),"^",1)]"" D EN^DDIOL("Pension Award Effective Date: ","","!?5") S Z=$$DATENP^DG1010P0(DGRP(.385),1) D EN^DDIOL(Z,"","?0") D
.. S Z=$$GET1^DIQ(2,DFN,.3852,"I") I Z]"" D EN^DDIOL("Pension Award Reason: ","","!?13") S Z=$$GET1^DIQ(27.18,Z,.01,"E") D EN^DDIOL(Z,"","?0")
. I $E(ZP,1)="N",$P(DGRP(.385),"^",3)]"" D EN^DDIOL("Pension Terminated Date: ","","!?10") S Z=$$DATENP^DG1010P0(DGRP(.385),3) D EN^DDIOL(Z,"","?0") D
.. S Z=$$GET1^DIQ(2,DFN,.3854,"I") I Z]"" D EN^DDIOL("Pension Terminated Reason 1: ","","!?6") S Z=$$GET1^DIQ(27.18,Z,.01,"E") D EN^DDIOL(Z,"","?0")
.. S Z=$$GET1^DIQ(2,DFN,.3855,"I") I Z]"" D EN^DDIOL("Pension Terminated Reason 2: ","","!?6") S Z=$$GET1^DIQ(27.18,Z,.01,"E") D EN^DDIOL(Z,"","?0")
.. S Z=$$GET1^DIQ(2,DFN,.3856,"I") I Z]"" D EN^DDIOL("Pension Terminated Reason 3: ","","!?6") S Z=$$GET1^DIQ(27.18,Z,.01,"E") D EN^DDIOL(Z,"","?0")
.. S Z=$$GET1^DIQ(2,DFN,.3857,"I") I Z]"" D EN^DDIOL("Pension Terminated Reason 4: ","","!?6") S Z=$$GET1^DIQ(27.18,Z,.01,"E") D EN^DDIOL(Z,"","?0")
D EN^DDIOL("VA Disability: ","","!?20") S Z=$$YN2^DG1010P0(DGRP(.3),11) D MBCK^DGRP7 D EN^DDIOL(Z,"","?0")
D EN^DDIOL("Total Check Amount: ","","!?15") S Z=$$DISP^DG1010P0(DGRP(.362),20,'DGMBCK) D EN^DDIOL($S(Z:"$"_Z,1:Z),"","?0")
D EN^DDIOL("GI Insurance: ","","!?21") D EN^DDIOL($$YN2^DG1010P0(DGRP(.362),17),"","?0")
D EN^DDIOL("Amount: ","","!?27") S Z=$$DISP^DG1010P0(DGRP(.362),6) D EN^DDIOL($S(Z:"$"_Z,1:Z),"","?0")
D EN^DDIOL(" ","","!!")
Q
;
DTCHK ;check to see that the pension award date is not greater than today or less that DOB+16 years
I $G(X)>DT D EN^DDIOL("The Pension Award Date must not be greater than today.","","!!!") K X Q
I $G(X)<($P(^DPT(DFN,0),U,3)+160000) D EN^DDIOL("The Pension Award Date must not be before the patient's 16th birthday.","","!!!") K X
Q
;
DISPPEN ;
I $P(DGRP(.362),"^",14)]"" S ZP=$$YN2^DG1010P0(DGRP(.362),14) D
. I $P(DGRP(.385),"^",1)]"" D EN^DDIOL("Pension Award Effective Date: ","","!?5") S Z=$$DATENP^DG1010P0(DGRP(.385),1) D EN^DDIOL(Z,"","?0") D
.. S Z=$$GET1^DIQ(2,DFN,.3852,"I") I Z]"" D EN^DDIOL("Pension Award Reason: ","","!?13") S Z=$$GET1^DIQ(27.18,Z,.01,"E") D EN^DDIOL(Z,"","?0")
. I $E(ZP,1)="N",$P(DGRP(.385),"^",3)]"" D EN^DDIOL("Pension Terminated Date: ","","!?10") S Z=$$DATENP^DG1010P0(DGRP(.385),3) D EN^DDIOL(Z,"","?0") D
.. S Z=$$GET1^DIQ(2,DFN,.3854,"I") I Z]"" D EN^DDIOL("Pension Terminated Reason 1: ","","!?6") S Z=$$GET1^DIQ(27.18,Z,.01,"E") D EN^DDIOL(Z,"","?0")
.. S Z=$$GET1^DIQ(2,DFN,.3855,"I") I Z]"" D EN^DDIOL("Pension Terminated Reason 2: ","","!?6") S Z=$$GET1^DIQ(27.18,Z,.01,"E") D EN^DDIOL(Z,"","?0")
.. S Z=$$GET1^DIQ(2,DFN,.3856,"I") I Z]"" D EN^DDIOL("Pension Terminated Reason 3: ","","!?6") S Z=$$GET1^DIQ(27.18,Z,.01,"E") D EN^DDIOL(Z,"","?0")
.. S Z=$$GET1^DIQ(2,DFN,.3857,"I") I Z]"" D EN^DDIOL("Pension Terminated Reason 4: ","","!?6") S Z=$$GET1^DIQ(27.18,Z,.01,"E") D EN^DDIOL(Z,"","?0")
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGRP7CP 4587 printed Sep 23, 2025@20:31:42 Page 2
DGRP7CP ;ALB/BDB,JAM - REGISTRATION SCREEN 7 EXPANSION FIELDS FOR VBA PENSION;04/21/2011
+1 ;;5.3;Registration;**842,1075**;Aug 13, 1993;Build 13
+2 ;
EN(DFN,QUIT) ; Display/edit Pension Award and Termination
+1 ; Returns QUIT=1 if ^ entered
+2 ;
EN1 DO CLEAR^VALM1
+1 NEW DGRP,X,Z,ZP,I,DGMBCK
+2 FOR I=0,.29,.3,.31,.32,.321,.36,.362,.385,"TYPE","VET"
SET DGRP(I)=$SELECT($DATA(^DPT(DFN,I)):^(I),1:"")
+3 DO EN^DDIOL(" COMPENSATION AND PENSION, SCREEN <7> EXPANSION","","!")
+4 DO EN^DDIOL($$SSNNM^DGRPU(DFN),"","!")
+5 SET X=$SELECT($DATA(DGRPTYPE):$PIECE(DGRPTYPE,"^",1),1:"PATIENT TYPE UNKNOWN")
SET X1=79-$LENGTH(X)
DO EN^DDIOL(X,"","?X1")
+6 SET X=""
SET $PIECE(X,"=",80)=""
DO EN^DDIOL(X,"","!")
+7 ;
+8 ; Patch D*5.3*1075 - for the next 3 fields, if value is UNANSWERED/NULL, change it to NO for Non-Veteran
+9 DO EN^DDIOL("Aid & Attendance: ","","!!?17")
+10 ;S Z=$$YN2^DG1010P0(DGRP(.362),12) D MBCK^DGRP7 D EN^DDIOL(Z,"","?0")
+11 SET Z=$$YN2^DG1010P0(DGRP(.362),12)
+12 IF Z="UNANSWERED"
IF $PIECE(DGRP("VET"),U)="N"
SET Z="NO"
+13 DO MBCK^DGRP7
DO EN^DDIOL(Z,"","?0")
+14 DO EN^DDIOL("Housebound: ","","!?23")
+15 ;S Z=$$YN2^DG1010P0(DGRP(.362),13) D MBCK^DGRP7 D EN^DDIOL(Z,"","?0")
+16 SET Z=$$YN2^DG1010P0(DGRP(.362),13)
+17 IF Z="UNANSWERED"
IF $PIECE(DGRP("VET"),U)="N"
SET Z="NO"
+18 DO MBCK^DGRP7
DO EN^DDIOL(Z,"","?0")
+19 DO EN^DDIOL("VA Pension: ","","!?23")
+20 ;I $P(DGRP(.362),"^",14)']"" D EN^DDIOL("UNANSWERED","","?0")
+21 IF $PIECE(DGRP(.362),"^",14)']""
Begin DoDot:1
+22 IF $PIECE(DGRP("VET"),U)="N"
DO EN^DDIOL("NO","","?0")
+23 IF $PIECE(DGRP("VET"),U)'="N"
DO EN^DDIOL("UNANSWERED","","?0")
End DoDot:1
+24 ;
+25 IF $PIECE(DGRP(.362),"^",14)]""
SET ZP=$$YN2^DG1010P0(DGRP(.362),14)
DO MBCK^DGRP7
DO EN^DDIOL(ZP,"","?0")
Begin DoDot:1
+26 IF $PIECE(DGRP(.385),"^",1)]""
DO EN^DDIOL("Pension Award Effective Date: ","","!?5")
SET Z=$$DATENP^DG1010P0(DGRP(.385),1)
DO EN^DDIOL(Z,"","?0")
Begin DoDot:2
+27 SET Z=$$GET1^DIQ(2,DFN,.3852,"I")
IF Z]""
DO EN^DDIOL("Pension Award Reason: ","","!?13")
SET Z=$$GET1^DIQ(27.18,Z,.01,"E")
DO EN^DDIOL(Z,"","?0")
End DoDot:2
+28 IF $EXTRACT(ZP,1)="N"
IF $PIECE(DGRP(.385),"^",3)]""
DO EN^DDIOL("Pension Terminated Date: ","","!?10")
SET Z=$$DATENP^DG1010P0(DGRP(.385),3)
DO EN^DDIOL(Z,"","?0")
Begin DoDot:2
+29 SET Z=$$GET1^DIQ(2,DFN,.3854,"I")
IF Z]""
DO EN^DDIOL("Pension Terminated Reason 1: ","","!?6")
SET Z=$$GET1^DIQ(27.18,Z,.01,"E")
DO EN^DDIOL(Z,"","?0")
+30 SET Z=$$GET1^DIQ(2,DFN,.3855,"I")
IF Z]""
DO EN^DDIOL("Pension Terminated Reason 2: ","","!?6")
SET Z=$$GET1^DIQ(27.18,Z,.01,"E")
DO EN^DDIOL(Z,"","?0")
+31 SET Z=$$GET1^DIQ(2,DFN,.3856,"I")
IF Z]""
DO EN^DDIOL("Pension Terminated Reason 3: ","","!?6")
SET Z=$$GET1^DIQ(27.18,Z,.01,"E")
DO EN^DDIOL(Z,"","?0")
+32 SET Z=$$GET1^DIQ(2,DFN,.3857,"I")
IF Z]""
DO EN^DDIOL("Pension Terminated Reason 4: ","","!?6")
SET Z=$$GET1^DIQ(27.18,Z,.01,"E")
DO EN^DDIOL(Z,"","?0")
End DoDot:2
End DoDot:1
+33 DO EN^DDIOL("VA Disability: ","","!?20")
SET Z=$$YN2^DG1010P0(DGRP(.3),11)
DO MBCK^DGRP7
DO EN^DDIOL(Z,"","?0")
+34 DO EN^DDIOL("Total Check Amount: ","","!?15")
SET Z=$$DISP^DG1010P0(DGRP(.362),20,'DGMBCK)
DO EN^DDIOL($SELECT(Z:"$"_Z,1:Z),"","?0")
+35 DO EN^DDIOL("GI Insurance: ","","!?21")
DO EN^DDIOL($$YN2^DG1010P0(DGRP(.362),17),"","?0")
+36 DO EN^DDIOL("Amount: ","","!?27")
SET Z=$$DISP^DG1010P0(DGRP(.362),6)
DO EN^DDIOL($SELECT(Z:"$"_Z,1:Z),"","?0")
+37 DO EN^DDIOL(" ","","!!")
+38 QUIT
+39 ;
DTCHK ;check to see that the pension award date is not greater than today or less that DOB+16 years
+1 IF $GET(X)>DT
DO EN^DDIOL("The Pension Award Date must not be greater than today.","","!!!")
KILL X
QUIT
+2 IF $GET(X)<($PIECE(^DPT(DFN,0),U,3)+160000)
DO EN^DDIOL("The Pension Award Date must not be before the patient's 16th birthday.","","!!!")
KILL X
+3 QUIT
+4 ;
DISPPEN ;
+1 IF $PIECE(DGRP(.362),"^",14)]""
SET ZP=$$YN2^DG1010P0(DGRP(.362),14)
Begin DoDot:1
+2 IF $PIECE(DGRP(.385),"^",1)]""
DO EN^DDIOL("Pension Award Effective Date: ","","!?5")
SET Z=$$DATENP^DG1010P0(DGRP(.385),1)
DO EN^DDIOL(Z,"","?0")
Begin DoDot:2
+3 SET Z=$$GET1^DIQ(2,DFN,.3852,"I")
IF Z]""
DO EN^DDIOL("Pension Award Reason: ","","!?13")
SET Z=$$GET1^DIQ(27.18,Z,.01,"E")
DO EN^DDIOL(Z,"","?0")
End DoDot:2
+4 IF $EXTRACT(ZP,1)="N"
IF $PIECE(DGRP(.385),"^",3)]""
DO EN^DDIOL("Pension Terminated Date: ","","!?10")
SET Z=$$DATENP^DG1010P0(DGRP(.385),3)
DO EN^DDIOL(Z,"","?0")
Begin DoDot:2
+5 SET Z=$$GET1^DIQ(2,DFN,.3854,"I")
IF Z]""
DO EN^DDIOL("Pension Terminated Reason 1: ","","!?6")
SET Z=$$GET1^DIQ(27.18,Z,.01,"E")
DO EN^DDIOL(Z,"","?0")
+6 SET Z=$$GET1^DIQ(2,DFN,.3855,"I")
IF Z]""
DO EN^DDIOL("Pension Terminated Reason 2: ","","!?6")
SET Z=$$GET1^DIQ(27.18,Z,.01,"E")
DO EN^DDIOL(Z,"","?0")
+7 SET Z=$$GET1^DIQ(2,DFN,.3856,"I")
IF Z]""
DO EN^DDIOL("Pension Terminated Reason 3: ","","!?6")
SET Z=$$GET1^DIQ(27.18,Z,.01,"E")
DO EN^DDIOL(Z,"","?0")
+8 SET Z=$$GET1^DIQ(2,DFN,.3857,"I")
IF Z]""
DO EN^DDIOL("Pension Terminated Reason 4: ","","!?6")
SET Z=$$GET1^DIQ(27.18,Z,.01,"E")
DO EN^DDIOL(Z,"","?0")
End DoDot:2
End DoDot:1
+9 ;
