Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: GMRGRUT0

GMRGRUT0.m

Go to the documentation of this file.
  1. GMRGRUT0 ;CISC/RM-ROUTINE UTILITIES ;10/25/88
  1. ;;3.0;Text Generator;;Jan 24, 1996
  1. 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),
  1. ; AND GMRGST(2) IF PASSED WILL BE THE DATE/TIME THAT YOU
  1. ; WANT THE INFORMATION FOR THIS TERM.
  1. ; RETURNED IS GMRGSTAT=IEN OF AUDIT TRAIL^D/T^MOD
  1. Q:'$D(GMRGST) I '$D(GMRGST(2)) S GMRGST(2)=0
  1. E S GMRGST(2)=9999999-GMRGST(2)-.000001
  1. 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:"")
  1. S GMRGSTAT=$S(GMRGST(0)>0:GMRGST(0)_"^"_(9999999-GMRGST("DT"))_"^"_GMRGST("MOD"),1:0)
  1. K GMRGST
  1. Q
  1. FNDPRM ; FIND PRIME DOCUMENT(S) FOR THE TERM IN NODE GMRGND RETURNED IS
  1. ; IS GMRGPRM(IEN) WITH ALL PRIME DOCUMENTS FOR THIS TERM
  1. S GMRGND(1)=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
  1. K GMRGCYC(GMRGND),GMRGND,GMRGTMP
  1. Q
  1. PRMCHK ;
  1. 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:"")
  1. I GMRGND("CI")="PRIME DOCUMENT" S GMRGPRM(GMRGND(2))="" Q
  1. S GMRGTMP=GMRGND(2) N GMRGND S GMRGND=GMRGTMP,GMRGCYC(GMRGND)="" D FNDPRM
  1. Q
  1. 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
  1. 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
  1. K GMRGND
  1. Q
  1. PARST ;
  1. K GMRGND("L")
  1. S GMRGND("O")=0,GMRGND("L")=""
  1. 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
  1. I 'GMRGND("O") D ST0
  1. I 'GMRGND("O"),GMRGND("L")'="" S ^GMR(124.3,GMRGND,1,"ALIST",GMRGND(1),GMRGND("L")+1)="^"_GMRGND(0)_"^0"
  1. Q
  1. ST0 F GMRGND(2)=0:0 S GMRGND(2)=$O(GMRGND("L",GMRGND(2))) Q:GMRGND(2)'>0 D ST2
  1. Q
  1. ST2 S GMRGND("L")=GMRGND(2)
  1. 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
  1. Q
  1. 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
  1. Q
  1. 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)
  1. F GMRGND(1)=0:0 S GMRGND(1)=$O(^GMRD(124.2,"AKID",GMRGND(0),GMRGND(1))) Q:GMRGND(1)'>0 D PARDL
  1. K GMRGND
  1. Q
  1. PARDL ;
  1. S GMRGND("O")=0
  1. 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
  1. Q
  1. DL0 ;
  1. S GMRGND("L")=$P(GMRGND("L"),("^"_GMRGND(0)_"^"))_"^"_$P(GMRGND("L"),("^"_GMRGND(0)_"^"),2)
  1. S ^GMR(124.3,GMRGND,1,"ALIST",GMRGND(1),GMRGND(2))=GMRGND("L")
  1. Q
  1. 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
  1. ; PART OF "ALIST" XREF FOR THIS PARENT.
  1. N X,FXN S FXN=0
  1. S Y=$P($G(^GMRD(124.2,PAR,0)),"^",2) I Y=3 S FXN=1
  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
  1. Q FXN