- 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 Jan 18, 2025@03:56:29 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;