source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGENA1A.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.6 KB
RevLine 
[613]1DGENA1A ;ALB/CJM,ISA/KWP,Zoltan,LBD,EG,CKN - Enrollment API - File Data Continued; 12/11/00 3:47pm ; 04/24/2006 8:57 AM
2 ;;5.3;Registration;**121,147,232,314,564,672,659,653**;Aug 13,1993;Build 2
3 ;
4KILLALL(DGENRIEN) ;
5 ;kills all x-refs on the record in the Patient Enrollment file
6 ;pointed to by DGENRIEN
7 ;
8 N DGENR,SUB,VALUE
9 Q:'$G(DGENRIEN)
10 Q:'$$GET^DGENA(DGENRIEN,.DGENR)
11 S SUB=""
12 F S SUB=$O(DGENR(SUB)) Q:SUB="" D
13 .Q:(SUB="ELIG")
14 .Q:DGENR(SUB)=""
15 .D KILL(27.11,DGENRIEN,$$FIELD^DGENU(SUB),DGENR(SUB))
16 S SUB=""
17 F S SUB=$O(DGENR("ELIG",SUB)) Q:SUB="" D
18 .Q:DGENR("ELIG",SUB)=""
19 .D KILL(27.11,DGENRIEN,$$FIELD^DGENU(SUB),DGENR("ELIG",SUB))
20 Q
21 ;
22SETALL(DGENRIEN,DGENR) ;
23 ;Sets all x-refs on the record in the Patient Enrollment file.
24 ;Inputs:
25 ; DGENRIEN - ptr to PATIENT ENROLLMENT file
26 ; DGENR - array containing the record, pass by reference
27 ;
28 N SUB,VALUE
29 Q:'$G(DGENRIEN)
30 Q:'$D(DGENR)
31 ;
32 S SUB=""
33 F S SUB=$O(DGENR(SUB)) Q:SUB="" D
34 .Q:(SUB="ELIG")
35 .Q:DGENR(SUB)=""
36 .D SET(27.11,DGENRIEN,$$FIELD^DGENU(SUB),DGENR(SUB))
37 S SUB=""
38 F S SUB=$O(DGENR("ELIG",SUB)) Q:SUB="" D
39 .Q:DGENR("ELIG",SUB)=""
40 .D SET(27.11,DGENRIEN,$$FIELD^DGENU(SUB),DGENR("ELIG",SUB))
41 Q
42 ;
43KILL(FILE,IEN,FIELD,VALUE) ;
44 ;executes all the kill logic for x-refs on the field=FIELD for the
45 ;record=DGENRIEN for the file=FILE for the field value=VALUE
46 ;
47 N D0,DA,DIV,DGIX,X
48 S DA=IEN,X=VALUE,DGIX=0
49 F S DGIX=$O(^DD(FILE,FIELD,1,DGIX)) Q:'DGIX X ^(DGIX,2) S X=VALUE
50 Q
51 ;
52SET(FILE,IEN,FIELD,VALUE) ;
53 ;executes all the set logic for x-refs on the field=FIELD for the
54 ;record=DGENRIEN for the file=FILE for the field value=VALUE
55 ;
56 N D0,DA,DIV,DGIX,X
57 S DA=IEN,X=VALUE,DGIX=0
58 F S DGIX=$O(^DD(FILE,FIELD,1,DGIX)) Q:'DGIX X ^(DGIX,1)
59 Q
60 ;
61EDIT(DA,DGENR) ;
62 ;Description: Overlays a currently existing record, ien=DA, with values
63 ; from DGENR array
64 ;Input -
65 ; DA - ien of record in Patient Enrollment file
66 ; DGENR - array containing an enrollment, pass by reference
67 ;Output - 1 on success, 0 on failure
68 ;
69 ; *** NOTE: This is called from within FM. There is a problem in ***
70 ; *** that ^DIE can not be used. Instead, the fields ***
71 ; *** are hard-set and cross-referenced. ***
72 ;
73 N NODE
74 Q:'$G(DA) 0
75 S NODE=$G(^DGEN(27.11,$G(DA),0))
76 Q:NODE="" 0
77 ;
78 ;kill off all the cross-references (FM doesn't have an API to do this)
79 D KILLALL(DA)
80 ;
81 ;now hand-set all the fields
82 ;Phase II Add subgroup to the 12 piece (SRS 6.4)
83 S NODE=DGENR("APP")_U_DGENR("DFN")_U_DGENR("SOURCE")_U_DGENR("STATUS")_U_DGENR("REASON")_U_DGENR("FACREC")_U_DGENR("PRIORITY")_U_DGENR("EFFDATE")_U_DGENR("PRIORREC")_U_DGENR("DATE")_U_DGENR("END")_U_DGENR("SUBGRP")
84 S ^DGEN(27.11,DA,0)=NODE
85 S ^DGEN(27.11,DA,"R")=DGENR("REMARKS")
86 S NODE=DGENR("ELIG","CODE")
87 S NODE=NODE_U_DGENR("ELIG","SC")
88 S NODE=NODE_U_DGENR("ELIG","SCPER")
89 S NODE=NODE_U_DGENR("ELIG","POW")
90 S NODE=NODE_U_DGENR("ELIG","A&A")
91 S NODE=NODE_U_DGENR("ELIG","HB")
92 S NODE=NODE_U_DGENR("ELIG","VAPEN")
93 S NODE=NODE_U_DGENR("ELIG","VACKAMT")
94 S NODE=NODE_U_DGENR("ELIG","DISRET")
95 S NODE=NODE_U_DGENR("ELIG","MEDICAID")
96 S NODE=NODE_U_DGENR("ELIG","AO")
97 S NODE=NODE_U_DGENR("ELIG","IR")
98 S NODE=NODE_U_DGENR("ELIG","EC")
99 S NODE=NODE_U_DGENR("ELIG","MTSTA")
100 S NODE=NODE_U_DGENR("ELIG","VCD")
101 S NODE=NODE_U_DGENR("ELIG","PH")
102 S NODE=NODE_U_DGENR("ELIG","UNEMPLOY")
103 S NODE=NODE_U_DGENR("ELIG","CVELEDT")
104 S NODE=NODE_U_DGENR("ELIG","SHAD") ;field added with DG*5.3*653
105 S NODE=NODE_U_DGENR("ELIG","DISLOD") ;field added with DG*5.3*672
106 S NODE=NODE_U_DGENR("ELIG","RADEXPM")
107 S ^DGEN(27.11,DA,"E")=NODE
108 S ^DGEN(27.11,DA,"U")=DGENR("DATETIME")_U_DGENR("USER")
109 ;
110 ;set the x-refs
111 D SETALL(DA,.DGENR)
112 Q 1
Note: See TracBrowser for help on using the repository browser.