DG53985E ;ALB/ARF - ENVIRONMENT CHECK FOR PATCH DG*5.3*985 ; 08-OCT-2019
;;5.3;REGISTRATION;**985**; 13-AUG-93;Build 15
;
;
EN ; This routine contains environmental checks which get executed
; before the DG*5.3*985 installation. It will check for entries in
; PREFERRED NAME(#.2405) in the PATIENT file (#2) that exceed 25
; characters. If these entries exist the install will be aborted.
;
; Input: Variables set by KIDS during environment check
;
; Output: XPDABORT - KIDS variable set to abort installation
;
W !!,">>> Beginning the Environment Checker"
;
D CHK ; check for PREFERRED NAME that is greater than 25 characters
;
I $D(XPDABORT) W !!,">>> DG*5.3*985 Aborted in Environment Checker",! Q
W !!,">>> Environment Checker Successful",!,">>> No PREFERRED NAME > 25 characters found",!
Q
;
CHK ; Check for PREFERRED NAME entries greater than 25 characters
;
N DGDFN,DGHDR,DGX,DGCNT
S DGHDR=1,DGCNT=0
S DGX="",$P(DGX,"=",78)=""
W !!?5,"Checking for PREFERRED NAME field (#.2405) in PATIENT file(#2)",!
W ?5,"for entries greater than 25 characters....",!
;
S DGDFN=""
F S DGDFN=$O(^DPT(DGDFN)) Q:DGDFN="" I $L($P($G(^DPT(DGDFN,.24)),U,5))>25 D
. W:DGHDR=1 !,"PREFERRED NAME found that exceeds limit",!!,"DFN",?25,"FULL ICN",!,DGX,! S DGHDR=0,XPDABORT=1
. W DGDFN,?25,$$GETICN^MPIF001(DGDFN),!
. S DGCNT=DGCNT+1
I '$D(XPDABORT) Q
; At least one PREFERRED NAME is greater than 25 characters
W !!,DGCNT_" record(s) found in the PATIENT (#2) file with a PREFERRED NAME(#.2405)"
W !,"field value exceeding 25 characters, installation aborted."
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG53985E 1631 printed Nov 22, 2024@17:49:26 Page 2
DG53985E ;ALB/ARF - ENVIRONMENT CHECK FOR PATCH DG*5.3*985 ; 08-OCT-2019
+1 ;;5.3;REGISTRATION;**985**; 13-AUG-93;Build 15
+2 ;
+3 ;
EN ; This routine contains environmental checks which get executed
+1 ; before the DG*5.3*985 installation. It will check for entries in
+2 ; PREFERRED NAME(#.2405) in the PATIENT file (#2) that exceed 25
+3 ; characters. If these entries exist the install will be aborted.
+4 ;
+5 ; Input: Variables set by KIDS during environment check
+6 ;
+7 ; Output: XPDABORT - KIDS variable set to abort installation
+8 ;
+9 WRITE !!,">>> Beginning the Environment Checker"
+10 ;
+11 ; check for PREFERRED NAME that is greater than 25 characters
DO CHK
+12 ;
+13 IF $DATA(XPDABORT)
WRITE !!,">>> DG*5.3*985 Aborted in Environment Checker",!
QUIT
+14 WRITE !!,">>> Environment Checker Successful",!,">>> No PREFERRED NAME > 25 characters found",!
+15 QUIT
+16 ;
CHK ; Check for PREFERRED NAME entries greater than 25 characters
+1 ;
+2 NEW DGDFN,DGHDR,DGX,DGCNT
+3 SET DGHDR=1
SET DGCNT=0
+4 SET DGX=""
SET $PIECE(DGX,"=",78)=""
+5 WRITE !!?5,"Checking for PREFERRED NAME field (#.2405) in PATIENT file(#2)",!
+6 WRITE ?5,"for entries greater than 25 characters....",!
+7 ;
+8 SET DGDFN=""
+9 FOR
SET DGDFN=$ORDER(^DPT(DGDFN))
if DGDFN=""
QUIT
IF $LENGTH($PIECE($GET(^DPT(DGDFN,.24)),U,5))>25
Begin DoDot:1
+10 if DGHDR=1
WRITE !,"PREFERRED NAME found that exceeds limit",!!,"DFN",?25,"FULL ICN",!,DGX,!
SET DGHDR=0
SET XPDABORT=1
+11 WRITE DGDFN,?25,$$GETICN^MPIF001(DGDFN),!
+12 SET DGCNT=DGCNT+1
End DoDot:1
+13 IF '$DATA(XPDABORT)
QUIT
+14 ; At least one PREFERRED NAME is greater than 25 characters
+15 WRITE !!,DGCNT_" record(s) found in the PATIENT (#2) file with a PREFERRED NAME(#.2405)"
+16 WRITE !,"field value exceeding 25 characters, installation aborted."
+17 ;
+18 QUIT
