GMRCDDX ;SLC/DLT - AC cross-referenc logic for 123.5, field .01 ; 8/20/18 4:54pm
;;3.0;CONSULT/REQUEST TRACKING;**1,6,104**;DEC 27, 1997;Build 9
;
SETAC ;Logic to set the heirarchy alphabetic cross reference on the menu item
;multiple based on the child-parent relationships in file 123.5
;The ACP cross-reference is used to find cross-reference entries that
;need to have the AC alphabetic cross-reference updated.
;The value in X will be used to create a new AC cross-reference.
; GMRCC=Child Service ien
; GMRCP=Parent Service ien
; GMRCE=Entry in Parent Sub-service multiple
;
N GMRCC,GMRCP,GMRCE
S GMRCC=DA,GMRCP=0
F S GMRCP=$O(^GMR(123.5,"APC",GMRCC,GMRCP)) Q:'GMRCP D
. S GMRCE=$O(^GMR(123.5,"APC",GMRCC,GMRCP,0)) Q:'GMRCE
. S ^GMR(123.5,GMRCP,10,"AC",$E(X,1,63),GMRCE)=""
. Q
Q
KILLAC ;Logic to kill the AC cross-reference entry with the name defined in
;the value of x.
N GMRCC,GMRCP,GMRCE
S GMRCC=DA,GMRCP=0
F S GMRCP=$O(^GMR(123.5,"APC",GMRCC,GMRCP)) Q:'GMRCP D
. S GMRCE=$O(^GMR(123.5,"APC",GMRCC,GMRCP,0)) Q:'GMRCE
. K ^GMR(123.5,GMRCP,10,"AC",$E(X,1,63),GMRCE)
. Q
Q
CHKDEL(DA) ;Logic to check if user can delete entries from file 123.5.
;1. Check to ensure the SUICIDE HOTLINE entry is never deleted.
;2. If we have an APC cross reference we will force the user to
; remove the child-parent relationship before deleting the parent.
;
;Varibles used:
; GMRCC=Child Service ien
; GMRCP=Parent Service ien
; GMRCE=Entry in Parent Sub-service multiple
; GMRCNC=Noded count for user message
; GMRCMSG=User message
; GMRCNAME=Name of Parent Service
;
;ICRs used:
; IA# 10142 EN^DDIOL
;
N GMRCC,GMRCP,GMRCE,GMRCNC,GMRCMSG,GMRCNAME
S GMRCC=DA,GMRCP=0,GMRCNC=1,(GMRCMSG,GMRCNAME)=""
I $P(^GMR(123.5,GMRCC,0),U)="SUICIDE HOTLINE" Q "...Mandatory Entry. Please see GMRC*3.0*57 for details..."
I $D(^GMR(123.5,"APC",GMRCC)) D Q " "
. S GMRCMSG(1)="This entry cannot be deleted until it is removed as a sub-service of:"
. F S GMRCP=$O(^GMR(123.5,"APC",GMRCC,GMRCP)) D Q:'+GMRCP
.. I '+GMRCP Q
.. S GMRCNC=GMRCNC+1
.. S GMRCNAME=$P(^GMR(123.5,GMRCP,0),U)
.. S GMRCMSG(GMRCNC)=GMRCNAME
.. S GMRCMSG(GMRCNC,"F")="!?5"
. D EN^DDIOL(.GMRCMSG)
Q ""
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCDDX 2265 printed Apr 09, 2024@20:53:10 Page 2
GMRCDDX ;SLC/DLT - AC cross-referenc logic for 123.5, field .01 ; 8/20/18 4:54pm
+1 ;;3.0;CONSULT/REQUEST TRACKING;**1,6,104**;DEC 27, 1997;Build 9
+2 ;
SETAC ;Logic to set the heirarchy alphabetic cross reference on the menu item
+1 ;multiple based on the child-parent relationships in file 123.5
+2 ;The ACP cross-reference is used to find cross-reference entries that
+3 ;need to have the AC alphabetic cross-reference updated.
+4 ;The value in X will be used to create a new AC cross-reference.
+5 ; GMRCC=Child Service ien
+6 ; GMRCP=Parent Service ien
+7 ; GMRCE=Entry in Parent Sub-service multiple
+8 ;
+9 NEW GMRCC,GMRCP,GMRCE
+10 SET GMRCC=DA
SET GMRCP=0
+11 FOR
SET GMRCP=$ORDER(^GMR(123.5,"APC",GMRCC,GMRCP))
if 'GMRCP
QUIT
Begin DoDot:1
+12 SET GMRCE=$ORDER(^GMR(123.5,"APC",GMRCC,GMRCP,0))
if 'GMRCE
QUIT
+13 SET ^GMR(123.5,GMRCP,10,"AC",$EXTRACT(X,1,63),GMRCE)=""
+14 QUIT
End DoDot:1
+15 QUIT
KILLAC ;Logic to kill the AC cross-reference entry with the name defined in
+1 ;the value of x.
+2 NEW GMRCC,GMRCP,GMRCE
+3 SET GMRCC=DA
SET GMRCP=0
+4 FOR
SET GMRCP=$ORDER(^GMR(123.5,"APC",GMRCC,GMRCP))
if 'GMRCP
QUIT
Begin DoDot:1
+5 SET GMRCE=$ORDER(^GMR(123.5,"APC",GMRCC,GMRCP,0))
if 'GMRCE
QUIT
+6 KILL ^GMR(123.5,GMRCP,10,"AC",$EXTRACT(X,1,63),GMRCE)
+7 QUIT
End DoDot:1
+8 QUIT
CHKDEL(DA) ;Logic to check if user can delete entries from file 123.5.
+1 ;1. Check to ensure the SUICIDE HOTLINE entry is never deleted.
+2 ;2. If we have an APC cross reference we will force the user to
+3 ; remove the child-parent relationship before deleting the parent.
+4 ;
+5 ;Varibles used:
+6 ; GMRCC=Child Service ien
+7 ; GMRCP=Parent Service ien
+8 ; GMRCE=Entry in Parent Sub-service multiple
+9 ; GMRCNC=Noded count for user message
+10 ; GMRCMSG=User message
+11 ; GMRCNAME=Name of Parent Service
+12 ;
+13 ;ICRs used:
+14 ; IA# 10142 EN^DDIOL
+15 ;
+16 NEW GMRCC,GMRCP,GMRCE,GMRCNC,GMRCMSG,GMRCNAME
+17 SET GMRCC=DA
SET GMRCP=0
SET GMRCNC=1
SET (GMRCMSG,GMRCNAME)=""
+18 IF $PIECE(^GMR(123.5,GMRCC,0),U)="SUICIDE HOTLINE"
QUIT "...Mandatory Entry. Please see GMRC*3.0*57 for details..."
+19 IF $DATA(^GMR(123.5,"APC",GMRCC))
Begin DoDot:1
+20 SET GMRCMSG(1)="This entry cannot be deleted until it is removed as a sub-service of:"
+21 FOR
SET GMRCP=$ORDER(^GMR(123.5,"APC",GMRCC,GMRCP))
Begin DoDot:2
+22 IF '+GMRCP
QUIT
+23 SET GMRCNC=GMRCNC+1
+24 SET GMRCNAME=$PIECE(^GMR(123.5,GMRCP,0),U)
+25 SET GMRCMSG(GMRCNC)=GMRCNAME
+26 SET GMRCMSG(GMRCNC,"F")="!?5"
End DoDot:2
if '+GMRCP
QUIT
+27 DO EN^DDIOL(.GMRCMSG)
End DoDot:1
QUIT " "
+28 QUIT ""
