DGRP7CC ;BAJ,EG - REGISTRATION SCREEN 7/CROSS REFERENCE CLEANUP ;10/24/2006
;;5.3;Registration;**657**;Aug 13, 1993;Build 19
EN ; entry point
;
; Code to TRIGGER deletion of field data.
N DGENDA,DATA,VAL,ERROR,CNT,FIELD,X
S DGENDA=DA
I $$CHNGD(DFN) D
. ;need to kill this node or the deletes won't work...
. ;you get a message that patient is not a veteran
. K ^DPT(DFN,"VET")
. F CNT=1:1 S FIELD=$P($T(DATA+CNT),";;",3) Q:FIELD="QUIT" D
.. S VAL=$S(FIELD=.301:"N",1:"@")
.. S DATA(FIELD)=VAL
.. Q
. S X=$$UPD^DGENDBS(2,DGENDA,.DATA,.ERROR)
. ; delete Service Related Conditions if NON-Vet
. D DELSVC(DFN)
. ;remove service connected and compensation connected eligibilities
. S X=$$OELIG(DFN)
. S ^DPT(DFN,"VET")="N"
. Q
Q
;
;
CHNGD(DFN) ; logic to determine if value has changed
N Y,X
; if a new entry read the array
I '$D(^DPT(DFN,"VET")) D Q X
. S Y(1)=$C(59)_$P($G(^DD(2,1901,0)),U,3) S X=$P($P(Y(1),$C(59)_Y(0)_":",2),$C(59))="NO"
;
; else read the "VET" value
S Y(2)=$C(59)_$P($G(^DD(2,1901,0)),U,3),Y(1)=$S($D(^DPT(DFN,"VET")):^DPT(DFN,"VET"),1:"") S X=$P($P(Y(2),$C(59)_$P(Y(1),U,1)_":",2),$C(59))="NO"
;
; Return 0 for VET, 1 for NON-Vet
Q X
;
DELSVC(DFN) ; Delete Service Connected Conditions
N DA,DIK
S DIK="^DPT("_DFN_",.373,"
S DA=0 F S DA=$O(^DPT(DFN,.373,DA)) Q:DA="" D ^DIK
Q
;
OELIG(DFN) ;remove sc codes from other eligibility
N DA,DIK,OLD,VAL,IEN,DE
S DIK="^DPT("_DFN_","_$C(34)_"E"_$C(34)_","
S DA=0 F S DA=$O(^DPT(DFN,"E",DA)) Q:DA="" D
. S IEN=$P($G(^DPT(DFN,"E",DA,0)),"^",1) I IEN="" Q
. S VAL=$P($G(^DIC(8,IEN,0)),"^",1)
. I $T(NVETNSC)'[(";"_VAL_";") Q
. S DA(1)=DFN
. D ^DIK
. Q
Q 1
DATA ;These are the fields to be changed
;;Receiving A&A;;.36205
;;Amount of A&A;;.3621
;;Receiving Housebound;;.36215
;;Amount of Housebound;;.3622
;;Receiving VA Pension;;.36235
;;Service Connected;;.301
;;Service Connected %-age;;.302
;;SC Award Date;;.3012
;;Eff. Date Combined SC% Eval;;.3014
;;Rated Incompetent;;.293
;;Date Ruled Incompetent (VA);;.291
;;Date Ruled Incompetent (Civil);;.292
;;VA Disability;;.3025
;;Amount of VA Disability;;.303
;;Amount of VA Pension;;.3624
;;Total Check Amount;;.36295
;;POW Indicated;;.525
;;POW War;;.526
;;POW Date From;;.527
;;POW Date To;;.528
;;Mil Disab Retirement;;.3602
;;Discharge Due to Disab;;.3603
;;QUIT;;QUIT
;;
NVETNSC ;;SC LESS THAN 50%;SERVICE CONNECTED 50% to 100%;NSC, VA PENSION;AID & ATTENDANCE;HOUSEBOUND;ALLIED VETERAN;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGRP7CC 2560 printed Apr 09, 2024@21:42:40 Page 2
DGRP7CC ;BAJ,EG - REGISTRATION SCREEN 7/CROSS REFERENCE CLEANUP ;10/24/2006
+1 ;;5.3;Registration;**657**;Aug 13, 1993;Build 19
EN ; entry point
+1 ;
+2 ; Code to TRIGGER deletion of field data.
+3 NEW DGENDA,DATA,VAL,ERROR,CNT,FIELD,X
+4 SET DGENDA=DA
+5 IF $$CHNGD(DFN)
Begin DoDot:1
+6 ;need to kill this node or the deletes won't work...
+7 ;you get a message that patient is not a veteran
+8 KILL ^DPT(DFN,"VET")
+9 FOR CNT=1:1
SET FIELD=$PIECE($TEXT(DATA+CNT),";;",3)
if FIELD="QUIT"
QUIT
Begin DoDot:2
+10 SET VAL=$SELECT(FIELD=.301:"N",1:"@")
+11 SET DATA(FIELD)=VAL
+12 QUIT
End DoDot:2
+13 SET X=$$UPD^DGENDBS(2,DGENDA,.DATA,.ERROR)
+14 ; delete Service Related Conditions if NON-Vet
+15 DO DELSVC(DFN)
+16 ;remove service connected and compensation connected eligibilities
+17 SET X=$$OELIG(DFN)
+18 SET ^DPT(DFN,"VET")="N"
+19 QUIT
End DoDot:1
+20 QUIT
+21 ;
+22 ;
CHNGD(DFN) ; logic to determine if value has changed
+1 NEW Y,X
+2 ; if a new entry read the array
+3 IF '$DATA(^DPT(DFN,"VET"))
Begin DoDot:1
+4 SET Y(1)=$CHAR(59)_$PIECE($GET(^DD(2,1901,0)),U,3)
SET X=$PIECE($PIECE(Y(1),$CHAR(59)_Y(0)_":",2),$CHAR(59))="NO"
End DoDot:1
QUIT X
+5 ;
+6 ; else read the "VET" value
+7 SET Y(2)=$CHAR(59)_$PIECE($GET(^DD(2,1901,0)),U,3)
SET Y(1)=$SELECT($DATA(^DPT(DFN,"VET")):^DPT(DFN,"VET"),1:"")
SET X=$PIECE($PIECE(Y(2),$CHAR(59)_$PIECE(Y(1),U,1)_":",2),$CHAR(59))="NO"
+8 ;
+9 ; Return 0 for VET, 1 for NON-Vet
+10 QUIT X
+11 ;
DELSVC(DFN) ; Delete Service Connected Conditions
+1 NEW DA,DIK
+2 SET DIK="^DPT("_DFN_",.373,"
+3 SET DA=0
FOR
SET DA=$ORDER(^DPT(DFN,.373,DA))
if DA=""
QUIT
DO ^DIK
+4 QUIT
+5 ;
OELIG(DFN) ;remove sc codes from other eligibility
+1 NEW DA,DIK,OLD,VAL,IEN,DE
+2 SET DIK="^DPT("_DFN_","_$CHAR(34)_"E"_$CHAR(34)_","
+3 SET DA=0
FOR
SET DA=$ORDER(^DPT(DFN,"E",DA))
if DA=""
QUIT
Begin DoDot:1
+4 SET IEN=$PIECE($GET(^DPT(DFN,"E",DA,0)),"^",1)
IF IEN=""
QUIT
+5 SET VAL=$PIECE($GET(^DIC(8,IEN,0)),"^",1)
+6 IF $TEXT(NVETNSC)'[(";"_VAL_";")
QUIT
+7 SET DA(1)=DFN
+8 DO ^DIK
+9 QUIT
End DoDot:1
+10 QUIT 1
DATA ;These are the fields to be changed
+1 ;;Receiving A&A;;.36205
+2 ;;Amount of A&A;;.3621
+3 ;;Receiving Housebound;;.36215
+4 ;;Amount of Housebound;;.3622
+5 ;;Receiving VA Pension;;.36235
+6 ;;Service Connected;;.301
+7 ;;Service Connected %-age;;.302
+8 ;;SC Award Date;;.3012
+9 ;;Eff. Date Combined SC% Eval;;.3014
+10 ;;Rated Incompetent;;.293
+11 ;;Date Ruled Incompetent (VA);;.291
+12 ;;Date Ruled Incompetent (Civil);;.292
+13 ;;VA Disability;;.3025
+14 ;;Amount of VA Disability;;.303
+15 ;;Amount of VA Pension;;.3624
+16 ;;Total Check Amount;;.36295
+17 ;;POW Indicated;;.525
+18 ;;POW War;;.526
+19 ;;POW Date From;;.527
+20 ;;POW Date To;;.528
+21 ;;Mil Disab Retirement;;.3602
+22 ;;Discharge Due to Disab;;.3603
+23 ;;QUIT;;QUIT
+24 ;;
NVETNSC ;;SC LESS THAN 50%;SERVICE CONNECTED 50% to 100%;NSC, VA PENSION;AID & ATTENDANCE;HOUSEBOUND;ALLIED VETERAN;
