- 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 Feb 18, 2025@23:22:08 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