- GMRGRUT0 ;CISC/RM-ROUTINE UTILITIES ;10/25/88
- ;;3.0;Text Generator;;Jan 24, 1996
- STAT ; ENTRY TO GIVE THE TYPE AND DATE OF THE LAST MODIFICATION ON THE
- ; SELECTION DEFINED BY GMRGST, AND GMR TEXT ENTRY GMRGST(1),
- ; AND GMRGST(2) IF PASSED WILL BE THE DATE/TIME THAT YOU
- ; WANT THE INFORMATION FOR THIS TERM.
- ; RETURNED IS GMRGSTAT=IEN OF AUDIT TRAIL^D/T^MOD
- Q:'$D(GMRGST) I '$D(GMRGST(2)) S GMRGST(2)=0
- E S GMRGST(2)=9999999-GMRGST(2)-.000001
- S GMRGST("DT")=$O(^GMR(124.3,GMRGST(1),1,GMRGST,2,"AA",GMRGST(2))),GMRGST("MOD")=$S(GMRGST("DT")>0:$O(^(GMRGST("DT"),0)),1:""),GMRGST(0)=$S(GMRGST("MOD")>0:$O(^(GMRGST("MOD"),0)),1:"")
- S GMRGSTAT=$S(GMRGST(0)>0:GMRGST(0)_"^"_(9999999-GMRGST("DT"))_"^"_GMRGST("MOD"),1:0)
- K GMRGST
- Q
- FNDPRM ; FIND PRIME DOCUMENT(S) FOR THE TERM IN NODE GMRGND RETURNED IS
- ; IS GMRGPRM(IEN) WITH ALL PRIME DOCUMENTS FOR THIS TERM
- S GMRGND(1)=1
- S GMRGND(2)=0 F GMRGND(1)=1:1 S GMRGND(2)=$O(^GMRD(124.2,"AKID",GMRGND,GMRGND(2))) Q:GMRGND(2)'>0 S:GMRGND(2)=GMRGCYC(0)!$D(GMRGCYC(GMRGND(2))) GMRGCYC=1 D:GMRGND(2)'=GMRGCYC(0)&'$D(GMRGCYC(GMRGND(2))) PRMCHK
- K GMRGCYC(GMRGND),GMRGND,GMRGTMP
- Q
- PRMCHK ;
- S GMRGND("C")=$S($D(^GMRD(124.2,GMRGND(2),0)):$P(^(0),"^",4),1:""),GMRGND("CI")=$S(GMRGND("C")="":"",$D(^GMRD(124.25,$P(^GMRD(124.2,GMRGND(2),0),"^",4),0)):$P(^(0),"^"),1:"")
- I GMRGND("CI")="PRIME DOCUMENT" S GMRGPRM(GMRGND(2))="" Q
- S GMRGTMP=GMRGND(2) N GMRGND S GMRGND=GMRGTMP,GMRGCYC(GMRGND)="" D FNDPRM
- Q
- STLST ; GIVEN THAT GMRGND=ENTRY IN 124.3, AND GMRGND(0)=TERM THAT HAS BEEN
- ; ADDED TO PLAN, UPDATE THE LIST XREF FOR GMRGND(0)'S PARENT
- F GMRGND(1)=0:0 S GMRGND(1)=$O(^GMRD(124.2,"AKID",GMRGND(0),GMRGND(1))) Q:GMRGND(1)'>0 S:'$D(GMRGRT)&$D(GMRG(0,GMRGND(1)))&'$D(^GMR(124.3,GMRGND,1,"ALIST",GMRGND(1))) ^(GMRGND(1),1)="^0" D:$D(^GMR(124.3,GMRGND,1,"ALIST",GMRGND(1))) PARST
- K GMRGND
- Q
- PARST ;
- K GMRGND("L")
- S GMRGND("O")=0,GMRGND("L")=""
- F GMRGND(2)=0:0 S GMRGND(2)=$O(^GMR(124.3,GMRGND,1,"ALIST",GMRGND(1),GMRGND(2))) Q:GMRGND(2)'>0 S GMRGND("L",GMRGND(2))=^GMR(124.3,GMRGND,1,"ALIST",GMRGND(1),GMRGND(2)) I GMRGND("L",GMRGND(2))[("^"_GMRGND(0)_"^") S GMRGND("O")=1 Q
- I 'GMRGND("O") D ST0
- I 'GMRGND("O"),GMRGND("L")'="" S ^GMR(124.3,GMRGND,1,"ALIST",GMRGND(1),GMRGND("L")+1)="^"_GMRGND(0)_"^0"
- Q
- ST0 F GMRGND(2)=0:0 S GMRGND(2)=$O(GMRGND("L",GMRGND(2))) Q:GMRGND(2)'>0 D ST2
- Q
- ST2 S GMRGND("L")=GMRGND(2)
- I ($L($P(GMRGND("L",GMRGND(2)),U,1,($L(GMRGND("L",GMRGND(2)),U)-1)))+2+$L(GMRGND(0))+$L($P(GMRGND("L",GMRGND(2)),U,$L(GMRGND("L",GMRGND(2)),U))))<245 D ST1
- Q
- ST1 S ^GMR(124.3,GMRGND,1,"ALIST",GMRGND(1),GMRGND(2))=$P(GMRGND("L",GMRGND(2)),U,1,($L(GMRGND("L",GMRGND(2)),U)-1))_U_GMRGND(0)_U_$P(GMRGND("L",GMRGND(2)),U,$L(GMRGND("L",GMRGND(2)),U)) S GMRGND("O")=1
- Q
- DLLST ; GIVEN THAT GMRGND=ENTRY IN 124.3, AND GMRGND(0)=TERM THAT HAS BEEN
- ; DELETED FROM PLAN, UPDATE THE LIST XREF FOR GMRGND(0)'S PARENT(S)
- F GMRGND(1)=0:0 S GMRGND(1)=$O(^GMRD(124.2,"AKID",GMRGND(0),GMRGND(1))) Q:GMRGND(1)'>0 D PARDL
- K GMRGND
- Q
- PARDL ;
- S GMRGND("O")=0
- F GMRGND(2)=0:0 S GMRGND(2)=$O(^GMR(124.3,GMRGND,1,"ALIST",GMRGND(1),GMRGND(2))) Q:GMRGND(2)'>0 S GMRGND("L")=^GMR(124.3,GMRGND,1,"ALIST",GMRGND(1),GMRGND(2)) I GMRGND("L")[("^"_GMRGND(0)_"^") D DL0
- Q
- DL0 ;
- S GMRGND("L")=$P(GMRGND("L"),("^"_GMRGND(0)_"^"))_"^"_$P(GMRGND("L"),("^"_GMRGND(0)_"^"),2)
- S ^GMR(124.3,GMRGND,1,"ALIST",GMRGND(1),GMRGND(2))=GMRGND("L")
- Q
- ALIST(IEN,PAR,CHIL) ; GIVEN THE 124.3 IEN (IEN), PARENT (PAR), AND CHILD
- ; (CHIL), THIS FUNCTION WILL RETURN TRUE(1)/FALSE(0) IF THIS CHILD IS
- ; PART OF "ALIST" XREF FOR THIS PARENT.
- N X,FXN S FXN=0
- S Y=$P($G(^GMRD(124.2,PAR,0)),"^",2) I Y=3 S FXN=1
- E S X=0 F S X=$O(^GMR(124.3,IEN,1,"ALIST",PAR,X)) Q:X'>0 I $G(^GMR(124.3,IEN,1,"ALIST",PAR,X))[("^"_CHIL_"^") S FXN=1 Q
- Q FXN
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRGRUT0 3836 printed Jan 18, 2025@02:56:45 Page 2
- GMRGRUT0 ;CISC/RM-ROUTINE UTILITIES ;10/25/88
- +1 ;;3.0;Text Generator;;Jan 24, 1996
- STAT ; ENTRY TO GIVE THE TYPE AND DATE OF THE LAST MODIFICATION ON THE
- +1 ; SELECTION DEFINED BY GMRGST, AND GMR TEXT ENTRY GMRGST(1),
- +2 ; AND GMRGST(2) IF PASSED WILL BE THE DATE/TIME THAT YOU
- +3 ; WANT THE INFORMATION FOR THIS TERM.
- +4 ; RETURNED IS GMRGSTAT=IEN OF AUDIT TRAIL^D/T^MOD
- +5 if '$DATA(GMRGST)
- QUIT
- IF '$DATA(GMRGST(2))
- SET GMRGST(2)=0
- +6 IF '$TEST
- SET GMRGST(2)=9999999-GMRGST(2)-.000001
- +7 SET GMRGST("DT")=$ORDER(^GMR(124.3,GMRGST(1),1,GMRGST,2,"AA",GMRGST(2)))
- SET GMRGST("MOD")=$SELECT(GMRGST("DT")>0:$ORDER(^(GMRGST("DT"),0)),1:"")
- SET GMRGST(0)=$SELECT(GMRGST("MOD")>0:$ORDER(^(GMRGST("MOD"),0)),1:"")
- +8 SET GMRGSTAT=$SELECT(GMRGST(0)>0:GMRGST(0)_"^"_(9999999-GMRGST("DT"))_"^"_GMRGST("MOD"),1:0)
- +9 KILL GMRGST
- +10 QUIT
- FNDPRM ; FIND PRIME DOCUMENT(S) FOR THE TERM IN NODE GMRGND RETURNED IS
- +1 ; IS GMRGPRM(IEN) WITH ALL PRIME DOCUMENTS FOR THIS TERM
- +2 SET GMRGND(1)=1
- +3 SET GMRGND(2)=0
- FOR GMRGND(1)=1:1
- SET GMRGND(2)=$ORDER(^GMRD(124.2,"AKID",GMRGND,GMRGND(2)))
- if GMRGND(2)'>0
- QUIT
- if GMRGND(2)=GMRGCYC(0)!$DATA(GMRGCYC(GMRGND(2)))
- SET GMRGCYC=1
- if GMRGND(2)'=GMRGCYC(0)&'$DATA(GMRGCYC(GMRGND(2)))
- DO PRMCHK
- +4 KILL GMRGCYC(GMRGND),GMRGND,GMRGTMP
- +5 QUIT
- PRMCHK ;
- +1 SET GMRGND("C")=$SELECT($DATA(^GMRD(124.2,GMRGND(2),0)):$PIECE(^(0),"^",4),1:"")
- SET GMRGND("CI")=$SELECT(GMRGND("C")="":"",$DATA(^GMRD(124.25,$PIECE(^GMRD(124.2,GMRGND(2),0),"^",4),0)):$PIECE(^(0),"^"),1:"")
- +2 IF GMRGND("CI")="PRIME DOCUMENT"
- SET GMRGPRM(GMRGND(2))=""
- QUIT
- +3 SET GMRGTMP=GMRGND(2)
- NEW GMRGND
- SET GMRGND=GMRGTMP
- SET GMRGCYC(GMRGND)=""
- DO FNDPRM
- +4 QUIT
- STLST ; GIVEN THAT GMRGND=ENTRY IN 124.3, AND GMRGND(0)=TERM THAT HAS BEEN
- +1 ; ADDED TO PLAN, UPDATE THE LIST XREF FOR GMRGND(0)'S PARENT
- +2 FOR GMRGND(1)=0:0
- SET GMRGND(1)=$ORDER(^GMRD(124.2,"AKID",GMRGND(0),GMRGND(1)))
- if GMRGND(1)'>0
- QUIT
- if '$DATA(GMRGRT)&$DATA(GMRG(0,GMRGND(1)))&'$DATA(^GMR(124.3,GMRGND,1,"ALIST",GMRGND(1)))
- SET ^(GMRGND(1),1)="^0"
- if $DATA(^GMR(124.3,GMRGND,1,"ALIST",GMRGND(1)))
- DO PARST
- +3 KILL GMRGND
- +4 QUIT
- PARST ;
- +1 KILL GMRGND("L")
- +2 SET GMRGND("O")=0
- SET GMRGND("L")=""
- +3 FOR GMRGND(2)=0:0
- SET GMRGND(2)=$ORDER(^GMR(124.3,GMRGND,1,"ALIST",GMRGND(1),GMRGND(2)))
- if GMRGND(2)'>0
- QUIT
- SET GMRGND("L",GMRGND(2))=^GMR(124.3,GMRGND,1,"ALIST",GMRGND(1),GMRGND(2))
- IF GMRGND("L",GMRGND(2))[("^"_GMRGND(0)_"^")
- SET GMRGND("O")=1
- QUIT
- +4 IF 'GMRGND("O")
- DO ST0
- +5 IF 'GMRGND("O")
- IF GMRGND("L")'=""
- SET ^GMR(124.3,GMRGND,1,"ALIST",GMRGND(1),GMRGND("L")+1)="^"_GMRGND(0)_"^0"
- +6 QUIT
- ST0 FOR GMRGND(2)=0:0
- SET GMRGND(2)=$ORDER(GMRGND("L",GMRGND(2)))
- if GMRGND(2)'>0
- QUIT
- DO ST2
- +1 QUIT
- ST2 SET GMRGND("L")=GMRGND(2)
- +1 IF ($LENGTH($PIECE(GMRGND("L",GMRGND(2)),U,1,($LENGTH(GMRGND("L",GMRGND(2)),U)-1)))+2+$LENGTH(GMRGND(0))+$LENGTH($PIECE(GMRGND("L",GMRGND(2)),U,$LENGTH(GMRGND("L",GMRGND(2)),U))))<245
- DO ST1
- +2 QUIT
- ST1 SET ^GMR(124.3,GMRGND,1,"ALIST",GMRGND(1),GMRGND(2))=$PIECE(GMRGND("L",GMRGND(2)),U,1,($LENGTH(GMRGND("L",GMRGND(2)),U)-1))_U_GMRGND(0)_U_$PIECE(GMRGND("L",GMRGND(2)),U,$LENGTH(GMRGND("L",GMRGND(2)),U))
- SET GMRGND("O")=1
- +1 QUIT
- DLLST ; GIVEN THAT GMRGND=ENTRY IN 124.3, AND GMRGND(0)=TERM THAT HAS BEEN
- +1 ; DELETED FROM PLAN, UPDATE THE LIST XREF FOR GMRGND(0)'S PARENT(S)
- +2 FOR GMRGND(1)=0:0
- SET GMRGND(1)=$ORDER(^GMRD(124.2,"AKID",GMRGND(0),GMRGND(1)))
- if GMRGND(1)'>0
- QUIT
- DO PARDL
- +3 KILL GMRGND
- +4 QUIT
- PARDL ;
- +1 SET GMRGND("O")=0
- +2 FOR GMRGND(2)=0:0
- SET GMRGND(2)=$ORDER(^GMR(124.3,GMRGND,1,"ALIST",GMRGND(1),GMRGND(2)))
- if GMRGND(2)'>0
- QUIT
- SET GMRGND("L")=^GMR(124.3,GMRGND,1,"ALIST",GMRGND(1),GMRGND(2))
- IF GMRGND("L")[("^"_GMRGND(0)_"^")
- DO DL0
- +3 QUIT
- DL0 ;
- +1 SET GMRGND("L")=$PIECE(GMRGND("L"),("^"_GMRGND(0)_"^"))_"^"_$PIECE(GMRGND("L"),("^"_GMRGND(0)_"^"),2)
- +2 SET ^GMR(124.3,GMRGND,1,"ALIST",GMRGND(1),GMRGND(2))=GMRGND("L")
- +3 QUIT
- ALIST(IEN,PAR,CHIL) ; GIVEN THE 124.3 IEN (IEN), PARENT (PAR), AND CHILD
- +1 ; (CHIL), THIS FUNCTION WILL RETURN TRUE(1)/FALSE(0) IF THIS CHILD IS
- +2 ; PART OF "ALIST" XREF FOR THIS PARENT.
- +3 NEW X,FXN
- SET FXN=0
- +4 SET Y=$PIECE($GET(^GMRD(124.2,PAR,0)),"^",2)
- IF Y=3
- SET FXN=1
- +5 IF '$TEST
- SET X=0
- FOR
- SET X=$ORDER(^GMR(124.3,IEN,1,"ALIST",PAR,X))
- if X'>0
- QUIT
- IF $GET(^GMR(124.3,IEN,1,"ALIST",PAR,X))[("^"_CHIL_"^")
- SET FXN=1
- QUIT
- +6 QUIT FXN