| 1 | IVMPREC9 ;ALB/KCL/BRM - PROCESS INCOMING (Z05 EVENT TYPE) HL7 MESSAGES (CON'T) ; 8/21/02 2:09pm
|
|---|
| 2 | ;;2.0;INCOME VERIFICATION MATCH;**34,58**; 21-OCT-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | ;
|
|---|
| 6 | ;
|
|---|
| 7 | STORE ; - store HL7 fields that have a different value than DHCP fields in
|
|---|
| 8 | ; the IVM Patient (#301.5) file (#301.511) multiple for uploading
|
|---|
| 9 | ;
|
|---|
| 10 | G:IVMFLG STORE2
|
|---|
| 11 | S X=$$IEN^IVMUFNC4("PID")
|
|---|
| 12 | ;
|
|---|
| 13 | K DIC("DR")
|
|---|
| 14 | S DA(1)=IVM3015
|
|---|
| 15 | I $G(^IVM(301.5,DA(1),"IN",0))']"" S ^(0)="^301.501PA^^"
|
|---|
| 16 | S DIC="^IVM(301.5,"_DA(1)_",""IN"",",DIC(0)="L",DLAYGO=301.501
|
|---|
| 17 | K DD,DO D FILE^DICN
|
|---|
| 18 | K DIC,DLAYGO,X,Y
|
|---|
| 19 | ;
|
|---|
| 20 | ; - build mail message if SUPRESS DEMOGRAPHIC NOTIFICATION field is
|
|---|
| 21 | ; not set in the IVM Site Parameter (#301.9) file
|
|---|
| 22 | ;
|
|---|
| 23 | I '$P($G(^IVM(301.9,1,0)),"^",5),'IVMADFLG D DEMBULL^IVMPREC6
|
|---|
| 24 | ;
|
|---|
| 25 | ; - set flag in order to not repeat STORE tag for one msg
|
|---|
| 26 | S IVMFLG=1
|
|---|
| 27 | ;
|
|---|
| 28 | S DA(2)=DA(1)
|
|---|
| 29 | S DA(1)=$P(^IVM(301.5,DA(1),"IN",0),"^",3)
|
|---|
| 30 | ;
|
|---|
| 31 | STORE2 ;
|
|---|
| 32 | ; - X as the record in the IVM Demo Upload Fields (#301.92) file
|
|---|
| 33 | S X=+IVMDEMDA
|
|---|
| 34 | I $G(^IVM(301.5,DA(2),"IN",DA(1),"DEM",0))']"" S ^(0)="^301.511PA^^"
|
|---|
| 35 | S DIC="^IVM(301.5,"_DA(2)_",""IN"",DA(1),""DEM"",",DIC(0)="L"
|
|---|
| 36 | S DIC("DR")=".02////^S X=IVMFLD",DLAYGO=301.511
|
|---|
| 37 | K DD,DO D FILE^DICN
|
|---|
| 38 | K DIC,DLAYGO,X,Y
|
|---|
| 39 | ;
|
|---|
| 40 | Q
|
|---|
| 41 | ;
|
|---|
| 42 | ;
|
|---|
| 43 | LOOK ; Find the current DHCP field value.
|
|---|
| 44 | ; Input: DR -- Field number of the field in file #2
|
|---|
| 45 | ; DFN -- Pointer to the patient in file #2
|
|---|
| 46 | ; Output: Y -- Internal value of field
|
|---|
| 47 | S DIC="^DPT(",DA=DFN,DIQ="IVM",DIQ(0)="I" D EN^DIQ1
|
|---|
| 48 | S Y=$G(IVM(2,DFN,DR,"I"))
|
|---|
| 49 | K DIC,DIQ,DR,IVM
|
|---|
| 50 | Q
|
|---|
