- 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 23, 2025@17:59:53 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 ""
