source: WorldVistAEHR/trunk/r/GEN_MED_REC_GENERATOR-GMRG/GMRGUT4.m@ 1006

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

initial load of WorldVistAEHR
File size: 3.1 KB
RevLine 
[613]1GMRGUT4 ;CISC/JH-DATA DICTIONARY UTILITIES (cont.) ;3/6/96
2 ;;3.0;Text Generator;**1**;Jan 24, 1996
3EN1 ; ENTRY FROM THE MUMPS CROSS-REFERENCE ON THE ENTERED IN ERROR (#5)
4 ; FIELD OF THE GMR TEXT (#124.3) FILE. THIS CROSS-REFERENCE TRIGGERS
5 ; THE DATE ENTERED IN ERROR (#5.1) AND USER ENTERING IN ERROR (#5.2)
6 ; FIELDS.
7 D NOW^%DTC S GMRG("X")=X,X=%,$P(^GMR(124.3,DA,5),"^",2)=X
8 F GMRG=0:0 S GMRG=$O(^DD(124.3,5.1,1,GMRG)) Q:GMRG'>0 X:$D(^DD(124.3,5.1,1,GMRG,1)) ^(1)
9 S X=DUZ,$P(^GMR(124.3,DA,5),"^",3)=X
10 F GMRG=0:0 S GMRG=$O(^DD(124.3,5.2,1,GMRG)) Q:GMRG'>0 X:$D(^DD(124.3,5.2,1,GMRG,1)) ^(1)
11Q1 S X=GMRG("X") K GMRG
12 Q
13EN7 ; ENTRY FROM AC XREF ON CHILD TEXT (#1) SUBFIELD OF CHILD (#1) FIELD
14 ; OF THE GMR AGGREGRATE TERM (#124.2) FILE
15 S GMRGX0(0)=$S($D(^GMRD(124.2,DA(1),1,DA,0)):^(0),1:"")
16 I GMRGX0("D")\100,$S('(GMRGX0("D")#2):1,GMRGX0("D")#2&'X:1,1:0) S GMRGX0=$P(GMRGX0(0),"^",7) D SDO G:GMRGX0'="" Q7 S GMRGX0=$P(GMRGX0(0),"^",2) D UPC,SDO G Q7
17 I GMRGX0("D")\100 S GMRGX0=$P(GMRGX0(0),"^",7) D KDO S GMRGX0=$P(GMRGX0(0),"^",2) D UPC,KDO G Q7
18 I GMRGX0("D")\10,GMRGX0("D")#2 S GMRGX0=X D SDO S GMRGX0=$P(GMRGX0(0),"^",2) D UPC,KDO G Q7
19 I GMRGX0("D")\10,'(GMRGX0("D")#2) S GMRGX0=X D KDO S GMRGX0=$P(GMRGX0(0),"^",2) D UPC,SDO G Q7
20 I '(GMRGX0("D")\10),GMRGX0("D")#2 S GMRGX0=$P(GMRGX0(0),"^",7) D SDO G Q7:GMRGX0'="" S GMRGX0=X D UPC,SDO G Q7
21 I '(GMRGX0("D")\10),'(GMRGX0("D")#2) S GMRGX0=$P(GMRGX0(0),"^",7) D SDO S GMRGX0=X D UPC,KDO
22Q7 K GMRGX0 Q
23 ;
24UPC F GMRGX0(1)=1:1:$L(GMRGX0) I $E(GMRGX0,GMRGX0(1))?1L S GMRGX0=$E(GMRGX0,1,GMRGX0(1)-1)_$C($A($E(GMRGX0,GMRGX0(1)))-32)_$E(GMRGX0,GMRGX0(1)+1,$L(GMRGX0))
25 Q
26 ;
27KDO K:GMRGX0'="" ^GMRD(124.2,DA(1),1,"AC",GMRGX0,DA) Q
28 ;
29SDO Q:$P(GMRGX0(0),"^",6) S:GMRGX0'="" ^GMRD(124.2,DA(1),1,"AC",GMRGX0,DA)="" Q
30 ;
31UPD(GMRG) ; This entry point will execute the set/kill logic for the
32 ; AUPD xref of the Audit Trail (.01) sub-field of the Audit Trail
33 ; (3) sub-field of the Selection (1) multiple of the GMR Text (124.3)
34 ; file. This xref will trigger data into the Date Last Updated (6)
35 ; field of the GMR Text file, if the date/time in that field is less
36 ; than the date/time of the Audit Trail field.
37 ;
38 ; Input variable: GMRG = 1 if set logic, 2 if kill logic
39 ;
40 Q:'$D(GMRGRT) N GMRGDA,GMRGX,GMRGLAUD,GMRGOAUD,GMRGDAT
41 S GMRGX=$G(^GMR(124.3,DA(2),0))
42 S GMRGOAUD=$P(GMRGX,"^",6),GMRGLAUD=$P(GMRGX,"^",3)
43 I GMRG=2 S GMRGDA(2)=DA(2),GMRGDA(1)=0 F S GMRGDA(1)=$O(^GMR(124.3,GMRGDA(2),1,GMRGDA(1))) Q:GMRGDA(1)'>0 S GMRGDA=0 F S GMRGDA=$O(^GMR(124.3,GMRGDA(2),1,GMRGDA(1),2,GMRGDA)) Q:GMRGDA'>0 D
44 . I GMRG=2,GMRGDA(1)=DA(1),GMRGDA=DA Q
45 . S GMRGX=$P($G(^GMR(124.3,GMRGDA(2),1,GMRGDA(1),2,GMRGDA,0)),"^")
46 . I GMRGX>GMRGLAUD S GMRGLAUD=GMRGX
47 . Q
48 I GMRG=1 S GMRGLAUD=$S(GMRGOAUD<X:X,1:GMRGOAUD)
49 I GMRGLAUD'=GMRGOAUD D
50 . S GMRGDAT(124.3,DA(2)_",",6)=GMRGLAUD
51 . D FILE^DIE("","GMRGDAT")
52 . Q
53 Q
54UPD1 ; Entry from set logic of AUPD xref of Date Created (.03) field of
55 ; GMR Text (124.3) file. This xref will trigger the value of
56 ; Date Created into the Date Last Updated (6) field if that field
57 ; has no data.
58 ;
59 N GMRG
60 S GMRG=$P($G(^GMR(124.3,DA,0)),"^",6)
61 I GMRG="" S GMRGDAT(124.3,DA_",",6)=X D FILE^DIE("","GMRGDAT")
62 Q
Note: See TracBrowser for help on using the repository browser.