GMRGUT4 ;CISC/JH-DATA DICTIONARY UTILITIES (cont.) ;3/6/96
;;3.0;Text Generator;**1**;Jan 24, 1996
EN1 ; ENTRY FROM THE MUMPS CROSS-REFERENCE ON THE ENTERED IN ERROR (#5)
; FIELD OF THE GMR TEXT (#124.3) FILE. THIS CROSS-REFERENCE TRIGGERS
; THE DATE ENTERED IN ERROR (#5.1) AND USER ENTERING IN ERROR (#5.2)
; FIELDS.
D NOW^%DTC S GMRG("X")=X,X=%,$P(^GMR(124.3,DA,5),"^",2)=X
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)
S X=DUZ,$P(^GMR(124.3,DA,5),"^",3)=X
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)
Q1 S X=GMRG("X") K GMRG
Q
EN7 ; ENTRY FROM AC XREF ON CHILD TEXT (#1) SUBFIELD OF CHILD (#1) FIELD
; OF THE GMR AGGREGRATE TERM (#124.2) FILE
S GMRGX0(0)=$S($D(^GMRD(124.2,DA(1),1,DA,0)):^(0),1:"")
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
I GMRGX0("D")\100 S GMRGX0=$P(GMRGX0(0),"^",7) D KDO S GMRGX0=$P(GMRGX0(0),"^",2) D UPC,KDO G Q7
I GMRGX0("D")\10,GMRGX0("D")#2 S GMRGX0=X D SDO S GMRGX0=$P(GMRGX0(0),"^",2) D UPC,KDO G Q7
I GMRGX0("D")\10,'(GMRGX0("D")#2) S GMRGX0=X D KDO S GMRGX0=$P(GMRGX0(0),"^",2) D UPC,SDO G Q7
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
I '(GMRGX0("D")\10),'(GMRGX0("D")#2) S GMRGX0=$P(GMRGX0(0),"^",7) D SDO S GMRGX0=X D UPC,KDO
Q7 K GMRGX0 Q
;
UPC 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))
Q
;
KDO K:GMRGX0'="" ^GMRD(124.2,DA(1),1,"AC",GMRGX0,DA) Q
;
SDO Q:$P(GMRGX0(0),"^",6) S:GMRGX0'="" ^GMRD(124.2,DA(1),1,"AC",GMRGX0,DA)="" Q
;
UPD(GMRG) ; This entry point will execute the set/kill logic for the
; AUPD xref of the Audit Trail (.01) sub-field of the Audit Trail
; (3) sub-field of the Selection (1) multiple of the GMR Text (124.3)
; file. This xref will trigger data into the Date Last Updated (6)
; field of the GMR Text file, if the date/time in that field is less
; than the date/time of the Audit Trail field.
;
; Input variable: GMRG = 1 if set logic, 2 if kill logic
;
Q:'$D(GMRGRT) N GMRGDA,GMRGX,GMRGLAUD,GMRGOAUD,GMRGDAT
S GMRGX=$G(^GMR(124.3,DA(2),0))
S GMRGOAUD=$P(GMRGX,"^",6),GMRGLAUD=$P(GMRGX,"^",3)
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
. I GMRG=2,GMRGDA(1)=DA(1),GMRGDA=DA Q
. S GMRGX=$P($G(^GMR(124.3,GMRGDA(2),1,GMRGDA(1),2,GMRGDA,0)),"^")
. I GMRGX>GMRGLAUD S GMRGLAUD=GMRGX
. Q
I GMRG=1 S GMRGLAUD=$S(GMRGOAUD<X:X,1:GMRGOAUD)
I GMRGLAUD'=GMRGOAUD D
. S GMRGDAT(124.3,DA(2)_",",6)=GMRGLAUD
. D FILE^DIE("","GMRGDAT")
. Q
Q
UPD1 ; Entry from set logic of AUPD xref of Date Created (.03) field of
; GMR Text (124.3) file. This xref will trigger the value of
; Date Created into the Date Last Updated (6) field if that field
; has no data.
;
N GMRG
S GMRG=$P($G(^GMR(124.3,DA,0)),"^",6)
I GMRG="" S GMRGDAT(124.3,DA_",",6)=X D FILE^DIE("","GMRGDAT")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRGUT4 3284 printed Sep 23, 2025@19:31:48 Page 2
GMRGUT4 ;CISC/JH-DATA DICTIONARY UTILITIES (cont.) ;3/6/96
+1 ;;3.0;Text Generator;**1**;Jan 24, 1996
EN1 ; ENTRY FROM THE MUMPS CROSS-REFERENCE ON THE ENTERED IN ERROR (#5)
+1 ; FIELD OF THE GMR TEXT (#124.3) FILE. THIS CROSS-REFERENCE TRIGGERS
+2 ; THE DATE ENTERED IN ERROR (#5.1) AND USER ENTERING IN ERROR (#5.2)
+3 ; FIELDS.
+4 DO NOW^%DTC
SET GMRG("X")=X
SET X=%
SET $PIECE(^GMR(124.3,DA,5),"^",2)=X
+5 FOR GMRG=0:0
SET GMRG=$ORDER(^DD(124.3,5.1,1,GMRG))
if GMRG'>0
QUIT
if $DATA(^DD(124.3,5.1,1,GMRG,1))
XECUTE ^(1)
+6 SET X=DUZ
SET $PIECE(^GMR(124.3,DA,5),"^",3)=X
+7 FOR GMRG=0:0
SET GMRG=$ORDER(^DD(124.3,5.2,1,GMRG))
if GMRG'>0
QUIT
if $DATA(^DD(124.3,5.2,1,GMRG,1))
XECUTE ^(1)
Q1 SET X=GMRG("X")
KILL GMRG
+1 QUIT
EN7 ; ENTRY FROM AC XREF ON CHILD TEXT (#1) SUBFIELD OF CHILD (#1) FIELD
+1 ; OF THE GMR AGGREGRATE TERM (#124.2) FILE
+2 SET GMRGX0(0)=$SELECT($DATA(^GMRD(124.2,DA(1),1,DA,0)):^(0),1:"")
+3 IF GMRGX0("D")\100
IF $SELECT('(GMRGX0("D")#2):1,GMRGX0("D")#2&'X:1,1:0)
SET GMRGX0=$PIECE(GMRGX0(0),"^",7)
DO SDO
if GMRGX0'=""
GOTO Q7
SET GMRGX0=$PIECE(GMRGX0(0),"^",2)
DO UPC
DO SDO
GOTO Q7
+4 IF GMRGX0("D")\100
SET GMRGX0=$PIECE(GMRGX0(0),"^",7)
DO KDO
SET GMRGX0=$PIECE(GMRGX0(0),"^",2)
DO UPC
DO KDO
GOTO Q7
+5 IF GMRGX0("D")\10
IF GMRGX0("D")#2
SET GMRGX0=X
DO SDO
SET GMRGX0=$PIECE(GMRGX0(0),"^",2)
DO UPC
DO KDO
GOTO Q7
+6 IF GMRGX0("D")\10
IF '(GMRGX0("D")#2)
SET GMRGX0=X
DO KDO
SET GMRGX0=$PIECE(GMRGX0(0),"^",2)
DO UPC
DO SDO
GOTO Q7
+7 IF '(GMRGX0("D")\10)
IF GMRGX0("D")#2
SET GMRGX0=$PIECE(GMRGX0(0),"^",7)
DO SDO
if GMRGX0'=""
GOTO Q7
SET GMRGX0=X
DO UPC
DO SDO
GOTO Q7
+8 IF '(GMRGX0("D")\10)
IF '(GMRGX0("D")#2)
SET GMRGX0=$PIECE(GMRGX0(0),"^",7)
DO SDO
SET GMRGX0=X
DO UPC
DO KDO
Q7 KILL GMRGX0
QUIT
+1 ;
UPC FOR GMRGX0(1)=1:1:$LENGTH(GMRGX0)
IF $EXTRACT(GMRGX0,GMRGX0(1))?1L
SET GMRGX0=$EXTRACT(GMRGX0,1,GMRGX0(1)-1)_$CHAR($ASCII($EXTRACT(GMRGX0,GMRGX0(1)))-32)_$EXTRACT(GMRGX0,GMRGX0(1)+1,$LENGTH(GMRGX0))
+1 QUIT
+2 ;
KDO if GMRGX0'=""
KILL ^GMRD(124.2,DA(1),1,"AC",GMRGX0,DA)
QUIT
+1 ;
SDO if $PIECE(GMRGX0(0),"^",6)
QUIT
if GMRGX0'=""
SET ^GMRD(124.2,DA(1),1,"AC",GMRGX0,DA)=""
QUIT
+1 ;
UPD(GMRG) ; This entry point will execute the set/kill logic for the
+1 ; AUPD xref of the Audit Trail (.01) sub-field of the Audit Trail
+2 ; (3) sub-field of the Selection (1) multiple of the GMR Text (124.3)
+3 ; file. This xref will trigger data into the Date Last Updated (6)
+4 ; field of the GMR Text file, if the date/time in that field is less
+5 ; than the date/time of the Audit Trail field.
+6 ;
+7 ; Input variable: GMRG = 1 if set logic, 2 if kill logic
+8 ;
+9 if '$DATA(GMRGRT)
QUIT
NEW GMRGDA,GMRGX,GMRGLAUD,GMRGOAUD,GMRGDAT
+10 SET GMRGX=$GET(^GMR(124.3,DA(2),0))
+11 SET GMRGOAUD=$PIECE(GMRGX,"^",6)
SET GMRGLAUD=$PIECE(GMRGX,"^",3)
+12 IF GMRG=2
SET GMRGDA(2)=DA(2)
SET GMRGDA(1)=0
FOR
SET GMRGDA(1)=$ORDER(^GMR(124.3,GMRGDA(2),1,GMRGDA(1)))
if GMRGDA(1)'>0
QUIT
SET GMRGDA=0
FOR
SET GMRGDA=$ORDER(^GMR(124.3,GMRGDA(2),1,GMRGDA(1),2,GMRGDA))
if GMRGDA'>0
QUIT
Begin DoDot:1
+13 IF GMRG=2
IF GMRGDA(1)=DA(1)
IF GMRGDA=DA
QUIT
+14 SET GMRGX=$PIECE($GET(^GMR(124.3,GMRGDA(2),1,GMRGDA(1),2,GMRGDA,0)),"^")
+15 IF GMRGX>GMRGLAUD
SET GMRGLAUD=GMRGX
+16 QUIT
End DoDot:1
+17 IF GMRG=1
SET GMRGLAUD=$SELECT(GMRGOAUD<X:X,1:GMRGOAUD)
+18 IF GMRGLAUD'=GMRGOAUD
Begin DoDot:1
+19 SET GMRGDAT(124.3,DA(2)_",",6)=GMRGLAUD
+20 DO FILE^DIE("","GMRGDAT")
+21 QUIT
End DoDot:1
+22 QUIT
UPD1 ; Entry from set logic of AUPD xref of Date Created (.03) field of
+1 ; GMR Text (124.3) file. This xref will trigger the value of
+2 ; Date Created into the Date Last Updated (6) field if that field
+3 ; has no data.
+4 ;
+5 NEW GMRG
+6 SET GMRG=$PIECE($GET(^GMR(124.3,DA,0)),"^",6)
+7 IF GMRG=""
SET GMRGDAT(124.3,DA_",",6)=X
DO FILE^DIE("","GMRGDAT")
+8 QUIT
