| 1 | IVMUM8 ;ALB/SEK - DELETE IVM MEANS TEST (CON'T) ; 13 JAN 94
|
|---|
| 2 | ;;2.0;INCOME VERIFICATION MATCH;**1,17**;21-OCT-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | EN ; change demo data in 408.12 & 408.13 back to VAMC values
|
|---|
| 6 | ; ivm12 408.12 ien
|
|---|
| 7 | ; ivm13 408.13 ien
|
|---|
| 8 | ; ivmmtien 408.31 ien
|
|---|
| 9 | ;
|
|---|
| 10 | ; note: 408.13 fields were added to 408.41 before 408.12 field
|
|---|
| 11 | ;
|
|---|
| 12 | K DR S IVM41=0
|
|---|
| 13 | F S IVM41=$O(^DGMT(408.41,"D",IVMMTIEN,IVM41)) Q:'IVM41 D
|
|---|
| 14 | .S IVM411=$G(^DGMT(408.41,+IVM41,0))
|
|---|
| 15 | .Q:$P(IVM411,"^",10)'=IVM13
|
|---|
| 16 | .S IVMOLD=$P(IVM411,"^",5)
|
|---|
| 17 | .S IVMOLD=$S(IVMOLD="":"@",1:IVMOLD)
|
|---|
| 18 | .S IVMFILE=$P(IVMAR1($P(IVM411,"^",2)),";")
|
|---|
| 19 | .S IVMNOD=$P(IVMAR1($P(IVM411,"^",2)),";",2)
|
|---|
| 20 | .I IVMFILE=408.13 S DA=IVM13,DIE="^DGPR(408.13,"
|
|---|
| 21 | .I IVMFILE=408.12 S DA=IVM12,DIE="^DGPR(408.12,"
|
|---|
| 22 | .S DR=IVMNOD_"////^S X=IVMOLD" D ^DIE K DA,DR,DIE
|
|---|
| 23 | .Q
|
|---|
| 24 | Q
|
|---|
| 25 | ;
|
|---|
| 26 | EN1 ; change primary income test for year? code from 0 to 1 for VAMC MT
|
|---|
| 27 | S DA=IVMVAMC,DIE="^DGMT(408.31,",DR="2////1" D ^DIE K DA,DIE,DR
|
|---|
| 28 | ;
|
|---|
| 29 | ; delete 408.31
|
|---|
| 30 | ;
|
|---|
| 31 | S DA=IVMMTIEN,DIK="^DGMT(408.31," D ^DIK
|
|---|
| 32 | ;
|
|---|
| 33 | ; open IVM case record which was closed during upload
|
|---|
| 34 | S DA=$O(^IVM(301.5,"APT",+DFN,+DGLY,0))
|
|---|
| 35 | I $G(^IVM(301.5,+DA,0))']"" G MTBULL
|
|---|
| 36 | S DR=".04////0",DIE="^IVM(301.5," D ^DIE
|
|---|
| 37 | K ^IVM(301.5,DA,1)
|
|---|
| 38 | ;
|
|---|
| 39 | MTBULL ; build and transmit mail message to IVM mail group notifying site
|
|---|
| 40 | ; that a means test was deleted.
|
|---|
| 41 | S IVMPAT=$$PT^IVMUFNC4(DFN)
|
|---|
| 42 | S XMSUB="IVM - MEANS TEST DELETED"
|
|---|
| 43 | S IVMTEXT(1)="An Income Verification Match Means Test was deleted for the"
|
|---|
| 44 | S IVMTEXT(2)="following patient:"
|
|---|
| 45 | S IVMTEXT(3)=" "
|
|---|
| 46 | S IVMTEXT(4)=" NAME: "_$P(IVMPAT,"^")
|
|---|
| 47 | S IVMTEXT(5)=" ID: "_$P(IVMPAT,"^",2)
|
|---|
| 48 | S Y=IVMMTDT X ^DD("DD")
|
|---|
| 49 | S IVMTEXT(6)=" DATE OF TEST: "_Y
|
|---|
| 50 | S IVMTEXT(7)=" "
|
|---|
| 51 | S IVMTEXT(8)="NOTE: The original DHCP Means Test is now the primary Means Test."
|
|---|
| 52 | D MAIL^IVMUFNC()
|
|---|
| 53 | ;
|
|---|
| 54 | ; call event driver
|
|---|
| 55 | S DGMTINF=1,DGMTP=IVMNO,DGMTA=IVMVNO
|
|---|
| 56 | S DGMTACT="DUP",DGMTI=IVMVAMC D EN^DGMTEVT
|
|---|
| 57 | S DGMTACT="DEL",DGMTI=IVMMTIEN D EN^DGMTEVT
|
|---|
| 58 | ;
|
|---|
| 59 | ; cleanup
|
|---|
| 60 | K DA,DFN,DGINC,DGINR,DGLY,DGMTA,DGMTACT,DGMTI,DGMTINF,DGMTP
|
|---|
| 61 | K DIE,DIK,DR,IVM12,IVM121,IVM13,IVM41,IVM411,IVMFILE
|
|---|
| 62 | K IVMFLGC,IVMMTDT,IVMMTIEN,IVMN,IVMNO,IVMNOD,IVMOLD
|
|---|
| 63 | K IVMPAT,IVMSOT,IVMTEXT,IVMVAMC,IVMVAMCA,IVMVNO,XMSUB,Y
|
|---|
| 64 | Q
|
|---|
| 65 | ;
|
|---|
| 66 | SETUPAR ; create array ivmar1
|
|---|
| 67 | ; subscript is 408.42 node (type of change - name, dob, ssn, sex, relationship)
|
|---|
| 68 | ; 1st piece is file 408.12 or 408.13
|
|---|
| 69 | ; 2nd piece is 408.12 or 408.13 field #
|
|---|
| 70 | F IVM41=4:1 S IVM411=$P($T(TYPECH+IVM41),";;",2) Q:IVM411="QUIT" D
|
|---|
| 71 | .S IVMAR1($P(IVM411,";"))=$P(IVM411,";",2,3)
|
|---|
| 72 | K IVM41,IVM411
|
|---|
| 73 | Q
|
|---|
| 74 | ;
|
|---|
| 75 | TYPECH ; type of dependent changes 408.41/408.42
|
|---|
| 76 | ; 1st piece - 408.42 table file node
|
|---|
| 77 | ; 2nd piece - file (408.12/408.13)
|
|---|
| 78 | ; 3rd piece - 408.12/408.13 field
|
|---|
| 79 | ;;16;408.13;.01
|
|---|
| 80 | ;;17;408.13;.03
|
|---|
| 81 | ;;18;408.13;.09
|
|---|
| 82 | ;;19;408.13;.02
|
|---|
| 83 | ;;20;408.12;.02
|
|---|
| 84 | ;;QUIT
|
|---|
