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

IVMCMD.m

Go to the documentation of this file.
  1. IVMCMD ;ALB/SEK,KCL,BRM - DELETE DCD INCOME TESTS ; 12/18/01 1:18pm
  1. ;;2.0;INCOME VERIFICATION MATCH;**17,33,49,187**;21-OCT-94;Build 3
  1. ;
  1. ;
  1. ;
  1. EN(IVMMTIEN) ; --
  1. ; This routine will process income test deletion requests received
  1. ; from the IVM Center.
  1. ;
  1. ; Input(s):
  1. ; IVMMTIEN - pointer to test to be deleted in file 408.31
  1. ;
  1. ; Output(s):
  1. ; Function Value - 1 test deleted
  1. ; 0 test not deleted
  1. ;
  1. ;
  1. ; Initialize variables
  1. N DFN,IVMERR,IVMLINK,IVMNODE0,IVMDOT,IVMTOT,IVMDONE,IVMLTC
  1. S IVMDONE=0
  1. ;
  1. EN1 ; Get zero node of (#408.31)
  1. S IVMNODE0=$G(^DGMT(408.31,IVMMTIEN,0))
  1. I 'IVMNODE0 Q 1 ; test not found
  1. S IVMDOT=$P(IVMNODE0,"^") ; date of test
  1. S DFN=$P(IVMNODE0,"^",2)
  1. S IVMTOT=$P(IVMNODE0,"^",19) ; type of test
  1. S IVMLINK=$P($G(^DGMT(408.31,IVMMTIEN,2)),"^",6)
  1. I IVMTOT=1,$D(^DGMT(408.31,"AT",IVMMTIEN)) S IVMLTC=$O(^DGMT(408.31,"AT",IVMMTIEN,""))
  1. I IVMTOT=2,IVMLINK Q 0 ; don't delete copay test linked to means test
  1. I IVMTOT=1 D I $D(IVMERR) Q 0 ;if MT linked, delete linked test
  1. .D:IVMLINK DELETE(IVMLINK,DFN,IVMDOT) ; delete copay test
  1. .D:$G(IVMLTC) DELETE(IVMLTC,DFN,IVMDOT) ; delete LTC test
  1. ;
  1. D DELETE(IVMMTIEN,DFN,IVMDOT) ; delete copay or MT
  1. Q IVMDONE
  1. ;
  1. DELETE(IVMMTIEN,DFN,IVMDOT) ; delete copay or MT
  1. ;
  1. ; Handle LTC test deletion if there is an associated Means Test
  1. I $P($G(^DGMT(408.31,+IVMMTIEN,0)),"^",19)=4,+$P($G(^DGMT(408.31,+IVMMTIEN,2)),"^",8) D DEL31^IVMCMD1(IVMMTIEN) Q
  1. ;
  1. ; Set DGMTP prior to delete
  1. N DGMTP
  1. S DGMTACT="DEL",DGMTI=IVMMTIEN D PRIOR^DGMTEVT
  1. ;
  1. ; Get Income Relation IEN array (DGINR) and
  1. ; Individual Annual Income IEN array (DGINC)
  1. D ALL^DGMTU21(DFN,"VSC",IVMDOT,"IR",IVMMTIEN)
  1. ;
  1. ;
  1. DEL22 ; Delete veteran, spouse, and dependent entries from the
  1. ; Income Relation (#408.22) file:
  1. ; - Veteran (#408.22) record
  1. S DA=$G(DGINR("V")) D
  1. .Q:'DA
  1. .S DIK="^DGMT(408.22,"
  1. .D ^DIK
  1. ;
  1. ; - Spouse (#408.22) record
  1. S DA=$G(DGINR("S")) D
  1. .Q:'DA
  1. .S DIK="^DGMT(408.22,"
  1. .D ^DIK
  1. ;
  1. ; - All dependent children (#408.22) records
  1. S IVMDEP=0
  1. F S IVMDEP=$O(DGINR("C",IVMDEP)) Q:'IVMDEP D
  1. .S DA=$G(DGINR("C",IVMDEP))
  1. .S DIK="^DGMT(408.22,"
  1. .D ^DIK
  1. ;
  1. ;
  1. DEL21 ; Delete veteran, spouse, and dependent entries from
  1. ; Individual Annual Income (#408.21) file:
  1. ; - Veteran (#408.21) record
  1. S DA=$G(DGINC("V")) D
  1. .Q:'DA
  1. .S DIK="^DGMT(408.21,"
  1. .D ^DIK
  1. ;
  1. ; - Spouse (#408.21) record
  1. S DA=$G(DGINC("S")) D
  1. .Q:'DA
  1. .S DIK="^DGMT(408.21,"
  1. .D ^DIK
  1. ;
  1. ; - All dependent children (#408.21) records
  1. S IVMDEP=0
  1. F S IVMDEP=$O(DGINC("C",IVMDEP)) Q:'IVMDEP D
  1. .S DA=$G(DGINC("C",IVMDEP))
  1. .S DIK="^DGMT(408.21,"
  1. .D ^DIK
  1. ;
  1. ;
  1. ; Logic for (#408.12/#408.1275) & (#408.13) file entries
  1. D SETUPAR
  1. ;
  1. ; Look for IVM/DCD Patient Realtion (#408.12) file entries.
  1. ; If no entries in "AIVM" x-ref, no dependent changes required.
  1. S IVM12="" F S IVM12=$O(^DGPR(408.12,"AIVM",IVMMTIEN,IVM12)) Q:'IVM12 D Q:$D(IVMERR)
  1. .; - if can't find entry in (#408.12), set IVMERR
  1. .I $G(^DGPR(408.12,+IVM12,0))']"" D Q
  1. ..S IVMERR="" Q
  1. .;
  1. .; - if only one record exists in (#408.1275) mult., then only one IVM/DCD dependent to delete
  1. .I $P($G(^DGPR(408.12,+IVM12,"E",0)),"^",4)=1 D Q
  1. ..;
  1. ..; -- if can't find entry in (#408.13), set IVMERR
  1. ..S IVM13=$P($P($G(^DGPR(408.12,+IVM12,0)),"^",3),";") I $G(^DGPR(408.13,+IVM13,0))']"" D Q
  1. ...S IVMERR="" Q
  1. ..;
  1. ..; -- delete (#408.12) & (#408.13) records for IVM/DCD dependent
  1. ..S DA=IVM12,DIK="^DGPR(408.12," D ^DIK K DA,DIK
  1. ..S DA=IVM13,DIK="^DGPR(408.13," D ^DIK K DA,DIK
  1. ..Q
  1. .;
  1. .;
  1. .; Delete (#408.1275) record for IVM/DCD dependent and
  1. .; change demo data in (#408.12) & (#408.13) back to VAMC values.
  1. .; OR, Delete (#408.1275) record for inactivated VAMC dependent.
  1. .S IVM121="",IVM121=$O(^DGPR(408.12,"AIVM",IVMMTIEN,+IVM12,IVM121))
  1. .; - if can't find entry in (#408.1275), set IVMERR
  1. .I $G(^DGPR(408.12,+IVM12,"E",+IVM121,0))']"" D Q
  1. ..S IVMERR="" Q
  1. .;
  1. .S IVMVAMCA=$P($G(^DGPR(408.12,+IVM12,"E",+IVM121,0)),"^",2) ; dependent active?
  1. .S DA(1)=IVM12,DA=IVM121,DIK="^DGPR(408.12,"_DA(1)_",""E"","
  1. .D ^DIK K DA(1),DA,DIK
  1. .;
  1. .; - quit if inactivated VAMC dependent
  1. .Q:'IVMVAMCA
  1. .;
  1. .; - get pointer to Income Person (#408.13) file
  1. .S IVM13=+$P($P($G(^DGPR(408.12,+IVM12,0)),"^",3),";")
  1. .;
  1. .; - change demo data back to original values
  1. .D DEMO
  1. .Q
  1. ;
  1. ; Complete deletion of income test
  1. D EN^IVMCMD1
  1. ;
  1. ENQ Q
  1. ;
  1. ;
  1. DEMO ; Change demographic data in (#408.12) & (#408.13) files
  1. ; back to original VAMC values.
  1. ;
  1. ; Input(s):
  1. ; IVM12 - as IEN of (#408.12) file
  1. ; IVM13 - as IEN of (#408.13) file
  1. ; IVMMTIEN - as IEN of (#408.31) file
  1. ;
  1. ; Output(s): None
  1. ;
  1. ; NOTE: File (#408.13) fields were added to (#408.41) file before
  1. ; file (#408.12) field.
  1. ;
  1. K DR S IVM41=0
  1. F S IVM41=$O(^DGMT(408.41,"D",IVMMTIEN,IVM41)) Q:'IVM41 D
  1. .S IVM411=$G(^DGMT(408.41,+IVM41,0))
  1. .Q:$P(IVM411,"^",10)'=IVM13
  1. .S IVMOLD=$P(IVM411,"^",5)
  1. .S IVMOLD=$S(IVMOLD="":"@",1:IVMOLD)
  1. .S IVMFILE=$P(IVMAR1($P(IVM411,"^",2)),";")
  1. .S IVMNOD=$P(IVMAR1($P(IVM411,"^",2)),";",2)
  1. .I IVMFILE=408.13 S DA=IVM13,DIE="^DGPR(408.13,"
  1. .I IVMFILE=408.12 S DA=IVM12,DIE="^DGPR(408.12,"
  1. .S DR=IVMNOD_"////^S X=IVMOLD"
  1. .D ^DIE K DA,DR,DIE
  1. Q
  1. ;
  1. ;
  1. SETUPAR ; Create array IVMAR1() where
  1. ; 1) Subscript is MT Changes Type (#408.42) file node where type of
  1. ; change = Name, DOB, SSN, Sex, Relationship.
  1. ; 2) 1st piece is (#408.12) or (#408.13) file.
  1. ; 3) 2nd piece is (#408.12) or (#408.13) file field number.
  1. ;
  1. F IVM41=4:1 S IVM411=$P($T(TYPECH+IVM41),";;",2) Q:IVM411="QUIT" D
  1. .S IVMAR1($P(IVM411,";"))=$P(IVM411,";",2,3)
  1. K IVM41,IVM411
  1. Q
  1. ;
  1. DELTYPE(DFN,MTDATE,TYPE) ;
  1. ;will delete any primary test for patient=DFN for same income year as
  1. ;MTDATE for test of type=TYPE
  1. ;
  1. Q:'$G(DFN)
  1. Q:'$G(MTDATE)
  1. Q:'$G(TYPE)
  1. N MTNODE,YEAR,RET
  1. S YEAR=$E(MTDATE,1,3)_1230.999999
  1. D
  1. .S MTNODE=$$LST^DGMTU(DFN,YEAR,TYPE)
  1. .Q:'+MTNODE
  1. .I $E($P(MTNODE,"^",2),1,3)'=$E(YEAR,1,3) Q
  1. .;don't want to delete auto-created Rx copay tests -they are deleted by
  1. .; deleting the MT that they are based on
  1. .I TYPE=2,+$P($G(^DGMT(408.31,+MTNODE,2)),"^",6) Q
  1. .I $P(MTNODE,"^",5),$P(MTNODE,"^",5)'=1 I $$EN(+MTNODE) D
  1. ..;
  1. ..S RET=$$LST^DGMTU(DFN,DT,IVMTYPE)
  1. ..I $E($P(RET,"^",2),1,3)'=$E(YEAR,1,3) S RET=""
  1. ..D ADD^IVMCMB(DFN,IVMTYPE,"DELETE PRMY TEST",$P(MTNODE,"^",2),$P(MTNODE,"^",4),$P(RET,"^",4))
  1. Q
  1. ;
  1. TYPECH ; Type of dependent changes (#408.41/#408.42) file
  1. ; 1st piece - 408.42 table file node
  1. ; 2nd piece - file (408.12/408.13)
  1. ; 3rd piece - 408.12/408.13 field
  1. ;;16;408.13;.01
  1. ;;17;408.13;.03
  1. ;;18;408.13;.09
  1. ;;19;408.13;.02
  1. ;;20;408.12;.02
  1. ;;QUIT
  1. Q