GMRGED7.m

GMRGED7 ;HIRMFO/RM-PATIENT DATA EDIT (cont.) ;1/9/96

 ;;3.0;Text Generator;;Jan 24, 1996

NOTMIN ; IF THE MINIMUM NUMBER OF SELECTIONS IS NOT MADE FOR A FRAME

 ; THEN THAT FRAME AND ALL SELECTED CHILDREN WILL BE DELETED.

 S GMRGDLT("G")="",GMRGDLT("P")=$P(GMRGTERM,"^"),GMRGDLT("T")=$P(GMRGTERM,"^",3)

NMIN ; LOOP THROUGH CHILDREN (TO DELETE IF NECESSARY) AND DELETE THE

 ; TERM ID'D BY GMRGDLT("P") IF NECESSARY.

 ;

 ; THE FOLLOWING 3 LINES OF COMMENTED CODE WILL BE SAVED UNTIL TG V4.

 ; THEY MAY BE NEEDED IF THE FIX IN THE TWO LINES THAT FOLLOW THEM

 ; CAUSE ANY PROBLEMS.

 ;F GMRGDLT("C")=0:0 S GMRGDLT("C")=$O(^GMRD(124.2,GMRGDLT("P"),1,"B",GMRGDLT("C"))) Q:GMRGDLT("C")'>0  I $D(^GMR(124.3,GMRGPDA,1,"ALIST",GMRGDLT("C"))) D CHMIN

 ;S GMRGTDL(0)=0 I GMRGDLT("G")'="" S GMRGND=GMRGDLT("P") F GMRGTDL=0:0 S GMRGTDL=$O(^GMRD(124.2,"AKID",GMRGDLT("P"),GMRGTDL)) Q:GMRGTDL'>0  I GMRGTDL'=GMRGDLT("G"),$D(^GMR(124.3,GMRGPDA,1,"ALIST",GMRGTDL)) S GMRGTDL(0)=1 Q

 ;I 'GMRGTDL(0),GMRGDLT("T")>0,GMRGDLT("P")'=+GMRGRT D DELMIN

 F GMRGDLT("C")=0:0 S GMRGDLT("C")=$O(^GMRD(124.2,GMRGDLT("P"),1,"B",GMRGDLT("C"))) Q:GMRGDLT("C")'>0  I '$$OTHPAR(GMRGPDA,GMRGDLT("C"),GMRGDLT("P")),$D(^GMR(124.3,GMRGPDA,1,"ALIST",GMRGDLT("C"))) D CHMIN

 I '$$OTHPAR(GMRGPDA,GMRGDLT("P"),GMRGDLT("G")),GMRGDLT("T")>0,GMRGDLT("P")'=+GMRGRT D DELMIN

 Q

CHMIN ; CALL NMIN RECURSIVELY FOR THE CHILDREN ACTIVE IN THE PLAN

 S GMRGTDL(0)=GMRGDLT("P"),GMRGTDL=GMRGDLT("C") N GMRGDLT S GMRGDLT("G")=GMRGTDL(0),GMRGDLT("P")=GMRGTDL

 S GMRGDLT("T")=$O(^GMR(124.3,GMRGPDA,1,"B",GMRGDLT("P"),0)) Q:GMRGDLT("T")'>0  Q:'$D(^GMR(124.3,GMRGPDA,1,GMRGDLT("T"),0))

 D NMIN

 Q

DELMIN ; DELETE THIS ENTRY FROM THE PLAN

 S GMRGTDL=0,GMRGDLT(0)=$G(^GMR(124.3,GMRGPDA,1,GMRGDLT("T"),0))

 I '$P(GMRGDLT(0),"^",3) F GMRG1=0:0 S GMRG1=$O(^GMR(124.3,GMRGPDA,1,GMRGDLT("T"),2,"AA",GMRG1)) S:GMRG1'>0 GMRGTDL=1 Q:GMRG1'>0  D DMIN Q:'GMRG1(1)

 I GMRGTDL,'$P(GMRGDLT(0),"^",3) S DA(1)=GMRGPDA,DA=GMRGDLT("T"),DIK="^GMR(124.3,DA(1),1," D ^DIK

 I $P(GMRGDLT(0),"^",3) S DA(1)=GMRGPDA,DA=GMRGDLT("T"),GMRGY=0,X=$P(GMRGDLT(0),"^") D EN1^GMRGUTL ;WE MAY HAVE TO EXECUTE ACTION ON FILING HERE, NOT SURE AT THIS TIME.

 Q

DMIN ;

 S GMRG1(0)=$O(^GMR(124.3,GMRGPDA,1,GMRGDLT("T"),2,"AA",GMRG1,"")),DA=$S(GMRG1(0)="":0,1:$O(^GMR(124.3,GMRGPDA,1,GMRGDLT("T"),2,"AA",GMRG1,GMRG1(0),0)))

 S GMRG1(0)=$S(DA'>0:"",$D(^GMR(124.3,GMRGPDA,1,GMRGDLT("T"),2,DA,0)):^(0),1:"") Q:GMRG1(0)'>0

 S GMRG1(1)=$P(GMRG1(0),"^",2) Q:'GMRG1(1)  S DA(2)=GMRGPDA,DA(1)=GMRGDLT("T")

 I $D(^GMR(124.3,DA(2),1,DA(1),2,DA,"ADD")),^("ADD")'="" D ADM

 I $D(^GMR(124.3,DA(2),1,DA(1),2,DA,0)),$P(^(0),"^",4)'="" D APM

 S DIK="^GMR(124.3,DA(2),1,DA(1),2," D ^DIK

 Q

ADM ;

 S GMRG1=DA,DA=DA(1),DA(1)=DA(2) K DA(2) S X=$S($D(^GMR(124.3,DA(1),1,DA,"ADD")):^("ADD"),1:"") I X'="" F GMRG2=0:0 S GMRG2=$O(^DD(124.31,2,1,GMRG2)) Q:GMRG2'>0  X:$D(^DD(124.31,2,1,GMRG2,2)) ^(2)

 S X=^GMR(124.3,DA(1),1,DA,2,GMRG1,"ADD") F GMRG2=0:0 S GMRG2=$O(^DD(124.31,2,1,GMRG2)) Q:GMRG2'>0  X:$D(^DD(124.31,2,1,GMRG2,1)) ^(1)

 S DA(2)=DA(1),DA(1)=DA,DA=GMRG1

 Q

APM ;

 S GMRG1=DA,DA=DA(1),DA(1)=DA(2) K DA(2) S X=$S($D(^GMR(124.3,DA(1),1,DA,0)):$P(^(0),"^",2),1:"") I X'="" F GMRG2=0:0 S GMRG2=$O(^DD(124.31,1,1,GMRG2)) Q:GMRG2'>0  X:$D(^DD(124.31,1,1,GMRG2,2)) ^(2)

 S X=$P(^GMR(124.3,DA(1),1,DA,2,GMRG1,0),"^",4) F GMRG2=0:0 S GMRG2=$O(^DD(124.31,1,1,GMRG2)) Q:GMRG2'>0  X:$D(^DD(124.31,1,1,GMRG2,1)) ^(1)

 S DA(2)=DA(1),DA(1)=DA,DA=GMRG1

 Q

BEGADD ; IF THE RECORD WHICH IS ABOUT TO BE EDITED HAS ANY ADDED FLAGS

 ; WHICH INDICATED NO THEN THESE FLAGS WILL BE FLIPPED TO INDICATE YES

 S DA(1)=GMRGPDA F DA=0:0 S DA=$O(^GMR(124.3,GMRGPDA,1,"ANOT",DA)) Q:DA'>0  I $D(^GMR(124.3,DA(1),1,DA,0)),'$P(^(0),"^",3) S GMRGTERM=$P(^(0),"^",1,2)_"^"_DA,GMRGTERM(0)=$S($D(^GMRD(124.2,+GMRGTERM,0)):^(0),1:"") D ADS^GMRGED6

 Q

OTHPAR(IEN,CHIL,PAR) ; Given the IEN of 124.3 entry (IEN) and Aggregate

 ; Term file pointers for the Child (CHIL) and Parent (PARN), this

 ; function will return True (1) if CHIL has another parent'=PARN

 ; that it is active for in IEN, else the function returns False (0).

 N FXN,X S FXN=0

 I PAR'="" S X=0 F  S X=$O(^GMRD(124.2,"AKID",CHIL,X)) Q:X'>0  I X'=PAR,$D(^GMR(124.3,IEN,1,"ALIST",X)) S FXN=1 Q

 Q FXN