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

DGRP7CC.m

Go to the documentation of this file.
  1. DGRP7CC ;BAJ,EG - REGISTRATION SCREEN 7/CROSS REFERENCE CLEANUP ;10/24/2006
  1. ;;5.3;Registration;**657**;Aug 13, 1993;Build 19
  1. EN ; entry point
  1. ;
  1. ; Code to TRIGGER deletion of field data.
  1. N DGENDA,DATA,VAL,ERROR,CNT,FIELD,X
  1. S DGENDA=DA
  1. I $$CHNGD(DFN) D
  1. . ;need to kill this node or the deletes won't work...
  1. . ;you get a message that patient is not a veteran
  1. . K ^DPT(DFN,"VET")
  1. . F CNT=1:1 S FIELD=$P($T(DATA+CNT),";;",3) Q:FIELD="QUIT" D
  1. .. S VAL=$S(FIELD=.301:"N",1:"@")
  1. .. S DATA(FIELD)=VAL
  1. .. Q
  1. . S X=$$UPD^DGENDBS(2,DGENDA,.DATA,.ERROR)
  1. . ; delete Service Related Conditions if NON-Vet
  1. . D DELSVC(DFN)
  1. . ;remove service connected and compensation connected eligibilities
  1. . S X=$$OELIG(DFN)
  1. . S ^DPT(DFN,"VET")="N"
  1. . Q
  1. Q
  1. ;
  1. ;
  1. CHNGD(DFN) ; logic to determine if value has changed
  1. N Y,X
  1. ; if a new entry read the array
  1. I '$D(^DPT(DFN,"VET")) D Q X
  1. . 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"
  1. ;
  1. ; else read the "VET" value
  1. 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"
  1. ;
  1. ; Return 0 for VET, 1 for NON-Vet
  1. Q X
  1. ;
  1. DELSVC(DFN) ; Delete Service Connected Conditions
  1. N DA,DIK
  1. S DIK="^DPT("_DFN_",.373,"
  1. S DA=0 F S DA=$O(^DPT(DFN,.373,DA)) Q:DA="" D ^DIK
  1. Q
  1. ;
  1. OELIG(DFN) ;remove sc codes from other eligibility
  1. N DA,DIK,OLD,VAL,IEN,DE
  1. S DIK="^DPT("_DFN_","_$C(34)_"E"_$C(34)_","
  1. S DA=0 F S DA=$O(^DPT(DFN,"E",DA)) Q:DA="" D
  1. . S IEN=$P($G(^DPT(DFN,"E",DA,0)),"^",1) I IEN="" Q
  1. . S VAL=$P($G(^DIC(8,IEN,0)),"^",1)
  1. . I $T(NVETNSC)'[(";"_VAL_";") Q
  1. . S DA(1)=DFN
  1. . D ^DIK
  1. . Q
  1. Q 1
  1. DATA ;These are the fields to be changed
  1. ;;Receiving A&A;;.36205
  1. ;;Amount of A&A;;.3621
  1. ;;Receiving Housebound;;.36215
  1. ;;Amount of Housebound;;.3622
  1. ;;Receiving VA Pension;;.36235
  1. ;;Service Connected;;.301
  1. ;;Service Connected %-age;;.302
  1. ;;SC Award Date;;.3012
  1. ;;Eff. Date Combined SC% Eval;;.3014
  1. ;;Rated Incompetent;;.293
  1. ;;Date Ruled Incompetent (VA);;.291
  1. ;;Date Ruled Incompetent (Civil);;.292
  1. ;;VA Disability;;.3025
  1. ;;Amount of VA Disability;;.303
  1. ;;Amount of VA Pension;;.3624
  1. ;;Total Check Amount;;.36295
  1. ;;POW Indicated;;.525
  1. ;;POW War;;.526
  1. ;;POW Date From;;.527
  1. ;;POW Date To;;.528
  1. ;;Mil Disab Retirement;;.3602
  1. ;;Discharge Due to Disab;;.3603
  1. ;;QUIT;;QUIT
  1. ;;
  1. NVETNSC ;;SC LESS THAN 50%;SERVICE CONNECTED 50% to 100%;NSC, VA PENSION;AID & ATTENDANCE;HOUSEBOUND;ALLIED VETERAN;