GMRGUTL ;HIRMFO/RM-UTILITIES ROUTINE FOR GMRG FILES ;5/2/96
;;3.0;Text Generator;**1**;Jan 24, 1996
EN1 ; ENTRY FROM AUD1 OR AUD2 XREFS TO SET AUDIT TRAIL ENTRY. IF GMRGY=1
; THE ENTRY WILL BE A CREATE, IF GMRGY=2 THE ENTRY WILL BE AN EDIT.
; I GMRGY=0 THEN THE ENTRY WILL BE A DELETE. THE VARIABLE GMRGY WILL BE
; KILLED, AND THE VARIABLES DA(1),DA, AND X WILL ALSO BE SET AND RESET.
Q:'$D(GMRGRT) S GMRGDA=DA,GMRGX=X I $D(DA)\10 F GMRGY(0)=0:0 S GMRGY(0)=$O(DA(GMRGY(0))) Q:GMRGY(0)'>0 S GMRGDA(GMRGY(0))=DA(GMRGY(0))
S DA(2)=GMRGDA(1),DA(1)=GMRGDA
S GMRGST(1)=DA(2),GMRGST=DA(1) D STAT^GMRGRUT0 S GMRGLDT=+$P(GMRGSTAT,"^",2),DA=+$P(GMRGSTAT,"^") D NOW^%DTC D:%'>GMRGLDT PAST S GMRGDT=%
G:GMRGY=0 A0:$P(GMRGSTAT,"^",3),Q1
I $D(GMRGZ),DA>0 S X=GMRGX D TEXT:'GMRGAT,ADTX:GMRGAT S X=$S(GMRGAT:$S($D(^GMR(124.3,DA(2),1,DA(1),0)):$P(^(0),U,2),1:""),1:$S($D(^GMR(124.3,DA(2),1,DA(1),"ADD")):^("ADD"),1:"")) D TEXT:GMRGAT,ADTX:'GMRGAT S X=GMRGX
I GMRGY=2,'$P(GMRGSTAT,"^",3) S GMRGY=1 D A0 S GMRGY=2 G EN1
A0 S:'$D(^GMR(124.3,DA(2),1,DA(1),2,0)) ^(0)="^124.313DAI^0^0" S DA=$P(^GMR(124.3,DA(2),1,DA(1),2,0),"^",3)
A1 S DA=DA+1 I $D(^GMR(124.3,DA(2),1,DA(1),2,DA,0)) G A1
S ^GMR(124.3,DA(2),1,DA(1),2,DA,0)=GMRGDT_"^"_GMRGY_"^"_DUZ,$P(^GMR(124.3,DA(2),1,DA(1),2,0),"^",3,4)=DA_"^"_($P(^GMR(124.3,DA(2),1,DA(1),2,0),"^",4)+1)
F GMRGY(0)=.01,1,2 S X=$S(GMRGY(0)=.01:GMRGDT,GMRGY(0)=1:GMRGY,1:DUZ) F GMRGY(1)=0:0 S GMRGY(1)=$O(^DD(124.313,GMRGY(0),1,GMRGY(1))) Q:GMRGY(1)'>0 X:$D(^DD(124.313,GMRGY(0),1,GMRGY(1),1)) ^(1)
I GMRGY=0 D EN1^GMRGUT0
Q1 K X,DA S X=GMRGX,DA=GMRGDA I $D(GMRGDA)\10 F GMRGY(0)=0:0 S GMRGY(0)=$O(GMRGDA(GMRGY(0))) Q:GMRGY(0)'>0 S DA(GMRGY(0))=GMRGDA(GMRGY(0))
K GMRGY,GMRGDA,GMRGX,GMRGLDT,GMRGDT,GMRGSTAT
Q
PAST ; ENTRY TO HANDLE DATE/TIME ENTRIES THAT ARE EARLIER THAN OR EQUAL
; TO, THE LAST DATE/TIME ENTERED
S %=$$FMADD^XLFDT(GMRGLDT,0,0,0,1)
Q
TEXT ; UPDATE SELECTION:AUDIT TRAIL:MODIFIED TEXT FIELD
S $P(^GMR(124.3,DA(2),1,DA(1),2,DA,0),U,4)=$E(X,1,175) F GMRGXX=0:0 S GMRGXX=$O(^DD(124.313,3,1,GMRGXX)) Q:GMRGXX'>0 X:$D(^DD(124.313,3,1,GMRGXX,1)) ^(1)
K GMRGXX
Q
ADTX ;
S ^GMR(124.3,DA(2),1,DA(1),2,DA,"ADD")=X F GMRGXX=0:0 S GMRGXX=$O(^DD(124.313,4,1,GMRGXX)) Q:GMRGXX'>0 X:$D(^DD(124.313,4,1,GMRGXX,1)) ^(1)
K GMRGXX
Q
EN2 ; ENTRY FROM SCREEN ON SET OF CODES FOR MODIFICATION FIELD (#1) OF
; THE AUDIT TRAIL SUBFIELD (#3) OF THE SELECTION MULTIPLE (#1) OF
; THE GMR TEXT (#124.3) FILE.
S GMRGZ(0)=$P($G(^GMR(124.3,DA(2),1,DA(1),2,DA,0)),"^"),GMRGZ(0)=$S(GMRGZ(0):GMRGZ(0),1:9999999)
S GMRGZ=$O(^GMR(124.3,DA(2),1,DA(1),2,"AA",9999999-GMRGZ(0))),GMRGZ=$S(GMRGZ'>0:"",1:$O(^(GMRGZ,0)))
I GMRGZ'>0,Y=1 G Q2
I GMRGZ=1,(Y=0!(Y=2)) G Q2
I GMRGZ=2,(Y=0!(Y=2))
Q2 K GMRGZ
Q
EN3 ; ENTRY FROM SCREEN ON CHILD SUBFILED (#.01) OF CHILDREN (#1) FIELD
; OF THE GMR AGGREGATE TERM (#124.2) FILE
I $P(^GMRD(124.2,D0,0),U,2)'>$P(^GMRD(124.2,+Y,0),U,2),D0'=+Y
Q
EN4 ; ENTRY FROM SCREEN ON SELECTION SUBFIELD (#.01) OF SELECTION FIELD
; (#1) OF THE GMR TEXT FILE (#124.3)
S GMRG("OK")=0,GMRG=$S($D(^GMR(124.3,D0,0)):$P(^(0),U),1:"") I GMRG>0,$D(^GMRD(124.2,"AKID",+Y,GMRG)) S GMRG("OK")=1
I 'GMRG("OK") F GMRG=0:0 Q:GMRG("OK") S GMRG=$O(^GMRD(124.2,"AKID",+Y,GMRG)) Q:GMRG'>0 S GMRG("OK")=$S($D(^GMR(124.3,D0,1,"B",GMRG)):1,1:0)
I GMRG("OK")
K GMRG,GMRGSTAT
Q
S4 I GMRG(0)>0,GMRG(0)'=+Y S GMRGST=GMRG(0),GMRGST(1)=D0 D STAT^GMRGRUT0 S GMRG("OK")=$S('$P(GMRGSTAT,U,3):0,1:1)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRGUTL 3488 printed Dec 13, 2024@01:55:46 Page 2
GMRGUTL ;HIRMFO/RM-UTILITIES ROUTINE FOR GMRG FILES ;5/2/96
+1 ;;3.0;Text Generator;**1**;Jan 24, 1996
EN1 ; ENTRY FROM AUD1 OR AUD2 XREFS TO SET AUDIT TRAIL ENTRY. IF GMRGY=1
+1 ; THE ENTRY WILL BE A CREATE, IF GMRGY=2 THE ENTRY WILL BE AN EDIT.
+2 ; I GMRGY=0 THEN THE ENTRY WILL BE A DELETE. THE VARIABLE GMRGY WILL BE
+3 ; KILLED, AND THE VARIABLES DA(1),DA, AND X WILL ALSO BE SET AND RESET.
+4 if '$DATA(GMRGRT)
QUIT
SET GMRGDA=DA
SET GMRGX=X
IF $DATA(DA)\10
FOR GMRGY(0)=0:0
SET GMRGY(0)=$ORDER(DA(GMRGY(0)))
if GMRGY(0)'>0
QUIT
SET GMRGDA(GMRGY(0))=DA(GMRGY(0))
+5 SET DA(2)=GMRGDA(1)
SET DA(1)=GMRGDA
+6 SET GMRGST(1)=DA(2)
SET GMRGST=DA(1)
DO STAT^GMRGRUT0
SET GMRGLDT=+$PIECE(GMRGSTAT,"^",2)
SET DA=+$PIECE(GMRGSTAT,"^")
DO NOW^%DTC
if %'>GMRGLDT
DO PAST
SET GMRGDT=%
+7 if GMRGY=0
if $PIECE(GMRGSTAT,"^",3)
GOTO A0
GOTO Q1
+8 IF $DATA(GMRGZ)
IF DA>0
SET X=GMRGX
if 'GMRGAT
DO TEXT
if GMRGAT
DO ADTX
SET X=$SELECT(GMRGAT:$SELECT($DATA(^GMR(124.3,DA(2),1,DA(1),0)):$PIECE(^(0),U,2),1:""),1:$SELECT($DATA(^GMR(124.3,DA(2),1,DA(1),"ADD")):^("ADD"),1:""))
if GMRGAT
DO TEXT
if 'GMRGAT
DO ADTX
SET X=GMRGX
+9 IF GMRGY=2
IF '$PIECE(GMRGSTAT,"^",3)
SET GMRGY=1
DO A0
SET GMRGY=2
GOTO EN1
A0 if '$DATA(^GMR(124.3,DA(2),1,DA(1),2,0))
SET ^(0)="^124.313DAI^0^0"
SET DA=$PIECE(^GMR(124.3,DA(2),1,DA(1),2,0),"^",3)
A1 SET DA=DA+1
IF $DATA(^GMR(124.3,DA(2),1,DA(1),2,DA,0))
GOTO A1
+1 SET ^GMR(124.3,DA(2),1,DA(1),2,DA,0)=GMRGDT_"^"_GMRGY_"^"_DUZ
SET $PIECE(^GMR(124.3,DA(2),1,DA(1),2,0),"^",3,4)=DA_"^"_($PIECE(^GMR(124.3,DA(2),1,DA(1),2,0),"^",4)+1)
+2 FOR GMRGY(0)=.01,1,2
SET X=$SELECT(GMRGY(0)=.01:GMRGDT,GMRGY(0)=1:GMRGY,1:DUZ)
FOR GMRGY(1)=0:0
SET GMRGY(1)=$ORDER(^DD(124.313,GMRGY(0),1,GMRGY(1)))
if GMRGY(1)'>0
QUIT
if $DATA(^DD(124.313,GMRGY(0),1,GMRGY(1),1))
XECUTE ^(1)
+3 IF GMRGY=0
DO EN1^GMRGUT0
Q1 KILL X,DA
SET X=GMRGX
SET DA=GMRGDA
IF $DATA(GMRGDA)\10
FOR GMRGY(0)=0:0
SET GMRGY(0)=$ORDER(GMRGDA(GMRGY(0)))
if GMRGY(0)'>0
QUIT
SET DA(GMRGY(0))=GMRGDA(GMRGY(0))
+1 KILL GMRGY,GMRGDA,GMRGX,GMRGLDT,GMRGDT,GMRGSTAT
+2 QUIT
PAST ; ENTRY TO HANDLE DATE/TIME ENTRIES THAT ARE EARLIER THAN OR EQUAL
+1 ; TO, THE LAST DATE/TIME ENTERED
+2 SET %=$$FMADD^XLFDT(GMRGLDT,0,0,0,1)
+3 QUIT
TEXT ; UPDATE SELECTION:AUDIT TRAIL:MODIFIED TEXT FIELD
+1 SET $PIECE(^GMR(124.3,DA(2),1,DA(1),2,DA,0),U,4)=$EXTRACT(X,1,175)
FOR GMRGXX=0:0
SET GMRGXX=$ORDER(^DD(124.313,3,1,GMRGXX))
if GMRGXX'>0
QUIT
if $DATA(^DD(124.313,3,1,GMRGXX,1))
XECUTE ^(1)
+2 KILL GMRGXX
+3 QUIT
ADTX ;
+1 SET ^GMR(124.3,DA(2),1,DA(1),2,DA,"ADD")=X
FOR GMRGXX=0:0
SET GMRGXX=$ORDER(^DD(124.313,4,1,GMRGXX))
if GMRGXX'>0
QUIT
if $DATA(^DD(124.313,4,1,GMRGXX,1))
XECUTE ^(1)
+2 KILL GMRGXX
+3 QUIT
EN2 ; ENTRY FROM SCREEN ON SET OF CODES FOR MODIFICATION FIELD (#1) OF
+1 ; THE AUDIT TRAIL SUBFIELD (#3) OF THE SELECTION MULTIPLE (#1) OF
+2 ; THE GMR TEXT (#124.3) FILE.
+3 SET GMRGZ(0)=$PIECE($GET(^GMR(124.3,DA(2),1,DA(1),2,DA,0)),"^")
SET GMRGZ(0)=$SELECT(GMRGZ(0):GMRGZ(0),1:9999999)
+4 SET GMRGZ=$ORDER(^GMR(124.3,DA(2),1,DA(1),2,"AA",9999999-GMRGZ(0)))
SET GMRGZ=$SELECT(GMRGZ'>0:"",1:$ORDER(^(GMRGZ,0)))
+5 IF GMRGZ'>0
IF Y=1
GOTO Q2
+6 IF GMRGZ=1
IF (Y=0!(Y=2))
GOTO Q2
+7 IF GMRGZ=2
IF (Y=0!(Y=2))
Q2 KILL GMRGZ
+1 QUIT
EN3 ; ENTRY FROM SCREEN ON CHILD SUBFILED (#.01) OF CHILDREN (#1) FIELD
+1 ; OF THE GMR AGGREGATE TERM (#124.2) FILE
+2 IF $PIECE(^GMRD(124.2,D0,0),U,2)'>$PIECE(^GMRD(124.2,+Y,0),U,2)
IF D0'=+Y
+3 QUIT
EN4 ; ENTRY FROM SCREEN ON SELECTION SUBFIELD (#.01) OF SELECTION FIELD
+1 ; (#1) OF THE GMR TEXT FILE (#124.3)
+2 SET GMRG("OK")=0
SET GMRG=$SELECT($DATA(^GMR(124.3,D0,0)):$PIECE(^(0),U),1:"")
IF GMRG>0
IF $DATA(^GMRD(124.2,"AKID",+Y,GMRG))
SET GMRG("OK")=1
+3 IF 'GMRG("OK")
FOR GMRG=0:0
if GMRG("OK")
QUIT
SET GMRG=$ORDER(^GMRD(124.2,"AKID",+Y,GMRG))
if GMRG'>0
QUIT
SET GMRG("OK")=$SELECT($DATA(^GMR(124.3,D0,1,"B",GMRG)):1,1:0)
+4 IF GMRG("OK")
+5 KILL GMRG,GMRGSTAT
+6 QUIT
S4 IF GMRG(0)>0
IF GMRG(0)'=+Y
SET GMRGST=GMRG(0)
SET GMRGST(1)=D0
DO STAT^GMRGRUT0
SET GMRG("OK")=$SELECT('$PIECE(GMRGSTAT,U,3):0,1:1)
+1 QUIT
