PXRMEXSP ;SLC/AGP - Auto packed utility. ;Oct 24, 2023@15:37:44
;;2.0;CLINICAL REMINDERS;**85**;Feb 04, 2005;Build 7
;
TESTER ;
N DESCTXT,EXNAME,INPUTS,NOTINLM
S INPUTS(811.9,"VA-WH PAP SMEAR SCREENING")=""
S INPUTS(811.9,"ZZVA-WH PAP SMEAR REVIEW RESULTS")=""
S INPUTS(801.41,"VA-WH PAP SMEAR SCREENING")=""
S INPUTS(801.41,"ZZVA-WH PAP SMEAR REVIEW RESULTS")=""
S DESCTXT(1)="Exchange file built when patch PXRM*2.0*81"
S DESCTXT(2)="was installed on "_$$FMTE^XLFDT($$NOW^XLFDT())
S NOTINLM=1,EXNAME="PXRM*2.0*81 AUTOMATIC BACKUP"
D CRE(EXNAME,.INPUTS,.DESCTXT,NOTINLM)
Q
;
;==========================
BACKUP(IEN) ;
N DIR,DESCTXT,EXNAME,FAIL,FILES,INPUTS,LIST,NAME,Y
S NAME=$P($G(^PXD(811.8,IEN,0)),U)
S DIR(0)="Y",DIR("B")="YES",DIR("A")="Back up selected files"
D ^DIR
I +Y'=1 Q
D FILELIST^PXRMEXRP(.FILES)
S FAIL=0
D PROC120^PXRMEXRP(.LIST,.FILES,IEN,.FAIL) I FAIL=1 W !,"Could not backup exchange entry "_NAME H 2 Q
M INPUTS=LIST("FILES")
S EXNAME=$S($L(NAME)<55:NAME_" (BACKUP)",1:$E(NAME,1,54)_" (BACKUP)")
D CRE(EXNAME,.INPUTS,.DESCTXT,0)
Q
;
;==========================
BLDDESC(TMPIND,DESCTXT) ;If multiple entries have been selected
;then initialize the description with the selected list.
N IND,NL,NOUT,TEXT,TEXTOUT
S NL=+$O(DESCTXT(""))+1
D FORMAT^PXRMTEXT(1,70,NL,.DESCTXT,.NOUT,.TEXTOUT)
K ^TMP(TMPIND,$J,"DESC")
F IND=1:1:NOUT S ^TMP(TMPIND,$J,"DESC",1,IND,0)=TEXTOUT(IND)
Q
;
BLDFSEL(SELLIST,FILELST,INPUTS) ;
N ERROR,FN,ID,IEN,NUMF
S FN=0,ERROR=0
F S FN=$O(INPUTS(FN)) Q:FN'>0!(ERROR=1) D
.S NUMF=0
.S ID="" F S ID=$O(INPUTS(FN,ID)) Q:ID=""!(ERROR=1) D
.. S IEN=$S(+ID>0:+ID,1:$$EXISTS^PXRMEXIU(FN,ID))
.. I IEN=0 S ERROR=1 Q
.. S NUMF=NUMF+1
.. S SELLIST(FN,NUMF)=IEN
.. S SELLIST(FN,"IEN",NUMF)=NUMF
I ERROR=1 Q 0
Q 1
;
;==========================
CRE(EXNAME,INPUTS,DESCTXT,NOTINLM) ;Pack a reminder component and store it in the repository.
N CMPLIST,CNT,DIEN,DERRFND,DERRMSG,EFNAME,ERROR,FAIL,FAILTYPE,FILELST
N OUTPUT,POA,RANK,SERROR,SELLIST,SUCCESS,TMPIND,USELIST
S TMPIND="PXRMEXPR"
K ^TMP(TMPIND,$J)
D GETFLST(.FILELST)
D PACKORD^PXRMEXPD(.RANK)
I '$$BLDFSEL(.SELLIST,.FILELST,.INPUTS) Q
;
K VALMHDR
I '$D(SELLIST) Q
;Save the user's selections.
M USELIST=SELLIST
;Process the selected list to build a complete list of components
;to be packed.
D CMPLIST^PXRMEXPD(.CMPLIST,.SELLIST,.FILELST,.ERROR)
I ERROR K ^TMP(TMPIND,$J) Q
S NOTINLM=$G(NOTINLM)
I '$$DEF(.SELLIST,TMPIND,NOTINLM) Q
I '$$TERM(.SELLIST,TMPIND,NOTINLM) Q
I '$$DIALOG(.SELLIST,TMPIND,NOTINLM) Q
;
;Create the header information.
S EFNAME=$S($G(EXNAME)'="":EXNAME,1:"")
S NOTINLM=$G(NOTINLM)
D HEADER(TMPIND,.USELIST,.SELLIST,.RANK,EXNAME,.DESCTXT)
I EXNAME=-1 Q
;
;Order the component list.
D ORDER^PXRMEXPD(.CMPLIST,.RANK,.POA)
;Pack the list
D PACK^PXRMEXPD(.CMPLIST,.POA,TMPIND,.SELLIST,.SERROR)
I SERROR K ^TMP(TMPIND,$J) Q
D STOREPR^PXRMEXU2(.SUCCESS,EXNAME,TMPIND,.SELLIST)
K ^TMP(TMPIND,$J)
I SUCCESS D
. I +$G(NOTINLM) D BMES^XPDUTL(EFNAME_" was saved in the Exchange File.") Q
. S VALMHDR(1)=EFNAME_" was saved in the Exchange File."
. D BLDLIST^PXRMEXLC(1)
E D
. I +$G(NOTINLM) D Q
..D BMES^XPDUTL("Creation of Exchange File entry "_EFNAME)
..D BMES^XPDUTL("failed; it was not saved!")
. S VALMHDR(1)="Creation of Exchange File entry "_EFNAME
. S VALMHDR(2)="failed; it was not saved!"
Q
;
DEF(SELLIST,TMPIND,NOTINLM) ;Check reminder definitions for errors.
N DIEN,FAIL,IDX,OK,OUTPUT
S FAIL=0
I $D(SELLIST(811.9)) D I FAIL K ^TMP(TMPIND,$J) Q 0
.;Check each reminder definition.
. I 'NOTINLM W !!,"Checking reminder definition(s) for errors."
. S IDX=0
. F S IDX=$O(SELLIST(811.9,"IEN",IDX)) Q:IDX'>0 D
.. S DIEN=+$G(SELLIST(811.9,IDX)) I DIEN=0 Q
.. I 'NOTINLM W !!,"Checking reminder definition "_$P(^PXD(811.9,DIEN,0),U,1)
.. K OUTPUT
.. S OK=$$DEF^PXRMICHK(DIEN,.OUTPUT,$S(NOTINLM=1:0,1:1))
.. I OK=0 S FAIL=1
I NOTINLM Q $S(FAIL=1:0,1:1)
I FAIL=0 W !!,"No fatal reminder definition problems were found, packing will continue."
I FAIL=1 W !!,"Cannot create the packed file, please correct the above fatal error(s)."
H 3
Q 1
;
DIALOG(SELLIST,TMPIND,NOTINLM) ;Check reminder dialogs for errors
N CNT,DIEN,FAIL,IDX,OUTPUT,FAILTYPE
S FAIL=0
K OUTPUT
I $D(SELLIST(801.41)) D I FAIL="F" K ^TMP(TMPIND,$J) Q 0
.I 'NOTINLM W !!,"Checking reminder dialog(s) for errors."
. S IDX=0
.;Check individual reminder dialogs
. F S IDX=$O(SELLIST(801.41,"IEN",IDX)) Q:IDX'>0 D
.. S DIEN=+$G(SELLIST(801.41,IDX)) I DIEN=0 Q
.. I FAIL=0 W "."
.. S FAILTYPE=$$RETARR^PXRMDLRP(DIEN,.OUTPUT) Q:'$D(OUTPUT)
.. I FAILTYPE="F" S FAIL="F"
.. I FAILTYPE="W",FAIL=0 S FAIL="W"
.. I 'NOTINLM D
... W !!,$S(FAILTYPE="W":"**WARNING**",FAILTYPE="F":"**FATAL ERROR**",1:"")
... S CNT=0 F S CNT=$O(OUTPUT(CNT)) Q:CNT'>0 W !,OUTPUT(CNT)
.. K OUTPUT
.;
I NOTINLM Q $S(FAIL=1:0,1:1)
I FAIL=0 W !!,"No fatal dialog problems were found, packing will continue."
I FAIL="F" W !!,"Cannot create the packed file, please correct the above fatal error(s)."
H 3
Q 1
;
GETFLST(FILELST) ;
S FILELST(1)=811.4_U_$$GET1^DID(811.4,"","","NAME")
S FILELST(2)=810.8_U_$$GET1^DID(810.8,"","","NAME")
S FILELST(3)=811.9_U_$$GET1^DID(811.9,"","","NAME")
S FILELST(4)=801.41_U_$$GET1^DID(801.41,"","","NAME")
S FILELST(5)=810.7_U_$$GET1^DID(810.7,"","","NAME")
S FILELST(6)=810.2_U_$$GET1^DID(810.2,"","","NAME")
S FILELST(7)=810.4_U_$$GET1^DID(810.4,"","","NAME")
S FILELST(8)=810.9_U_$$GET1^DID(810.9,"","","NAME")
S FILELST(9)=811.3_U_$$GET1^DID(811.3,"","","NAME")
S FILELST(10)=811.6_U_$$GET1^DID(811.6,"","","NAME")
S FILELST(11)=811.2_U_$$GET1^DID(811.2,"","","NAME")
S FILELST(12)=811.5_U_$$GET1^DID(811.5,"","","NAME")
S FILELST(13)=801_U_$$GET1^DID(801,"","","NAME")
S FILELST(14)=801.1_U_$$GET1^DID(801.1,"","","NAME")
S FILELST(0)=14
Q
;
;==========================
;information.
;Save the source information and the passed in description text.
D PUTSRC^PXRMEXPD("",EFNAME,TMPIND)
D BLDDESC(TMPIND,.DESCTXT)
;Add the packing attributes.
D PATTR^PXRMEXPD(TMPIND)
Q
;
TERM(SELLIST,TMPIND,NOTINLM) ;Check reminder terms for errors.
N DIEN,FAIL,IDX,OK,OUTPUT
S FAIL=0
I $D(SELLIST(811.5)) D I FAIL K ^TMP(TMPIND,$J) Q 0
.;Check each reminder term.
. I 'NOTINLM W !!,"Checking reminder term(s) for errors."
. S IDX=0
. F S IDX=$O(SELLIST(811.5,"IEN",IDX)) Q:IDX'>0 D
.. S DIEN=+$G(SELLIST(811.5,IDX)) I DIEN=0 Q
.. I 'NOTINLM W !!,"Checking reminder term "_$P(^PXRMD(811.5,DIEN,0),U,1)
.. K OUTPUT
.. S OK=$$TERM^PXRMICK1(DIEN,.OUTPUT,$S(NOTINLM=1:0,1:1))
.. I OK=0 S FAIL=1
I NOTINLM Q $S(FAIL=1:0,1:1)
I FAIL=0 W !!,"No fatal reminder term problems were found, packing will continue."
I FAIL=1 W !!,"Cannot create the packed file, please correct the above fatal error(s)."
H 3
Q $S(FAIL=1:0,1:1)
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMEXSP 7132 printed Dec 13, 2024@01:45:15 Page 2
PXRMEXSP ;SLC/AGP - Auto packed utility. ;Oct 24, 2023@15:37:44
+1 ;;2.0;CLINICAL REMINDERS;**85**;Feb 04, 2005;Build 7
+2 ;
TESTER ;
+1 NEW DESCTXT,EXNAME,INPUTS,NOTINLM
+2 SET INPUTS(811.9,"VA-WH PAP SMEAR SCREENING")=""
+3 SET INPUTS(811.9,"ZZVA-WH PAP SMEAR REVIEW RESULTS")=""
+4 SET INPUTS(801.41,"VA-WH PAP SMEAR SCREENING")=""
+5 SET INPUTS(801.41,"ZZVA-WH PAP SMEAR REVIEW RESULTS")=""
+6 SET DESCTXT(1)="Exchange file built when patch PXRM*2.0*81"
+7 SET DESCTXT(2)="was installed on "_$$FMTE^XLFDT($$NOW^XLFDT())
+8 SET NOTINLM=1
SET EXNAME="PXRM*2.0*81 AUTOMATIC BACKUP"
+9 DO CRE(EXNAME,.INPUTS,.DESCTXT,NOTINLM)
+10 QUIT
+11 ;
+12 ;==========================
BACKUP(IEN) ;
+1 NEW DIR,DESCTXT,EXNAME,FAIL,FILES,INPUTS,LIST,NAME,Y
+2 SET NAME=$PIECE($GET(^PXD(811.8,IEN,0)),U)
+3 SET DIR(0)="Y"
SET DIR("B")="YES"
SET DIR("A")="Back up selected files"
+4 DO ^DIR
+5 IF +Y'=1
QUIT
+6 DO FILELIST^PXRMEXRP(.FILES)
+7 SET FAIL=0
+8 DO PROC120^PXRMEXRP(.LIST,.FILES,IEN,.FAIL)
IF FAIL=1
WRITE !,"Could not backup exchange entry "_NAME
HANG 2
QUIT
+9 MERGE INPUTS=LIST("FILES")
+10 SET EXNAME=$SELECT($LENGTH(NAME)<55:NAME_" (BACKUP)",1:$EXTRACT(NAME,1,54)_" (BACKUP)")
+11 DO CRE(EXNAME,.INPUTS,.DESCTXT,0)
+12 QUIT
+13 ;
+14 ;==========================
BLDDESC(TMPIND,DESCTXT) ;If multiple entries have been selected
+1 ;then initialize the description with the selected list.
+2 NEW IND,NL,NOUT,TEXT,TEXTOUT
+3 SET NL=+$ORDER(DESCTXT(""))+1
+4 DO FORMAT^PXRMTEXT(1,70,NL,.DESCTXT,.NOUT,.TEXTOUT)
+5 KILL ^TMP(TMPIND,$JOB,"DESC")
+6 FOR IND=1:1:NOUT
SET ^TMP(TMPIND,$JOB,"DESC",1,IND,0)=TEXTOUT(IND)
+7 QUIT
+8 ;
BLDFSEL(SELLIST,FILELST,INPUTS) ;
+1 NEW ERROR,FN,ID,IEN,NUMF
+2 SET FN=0
SET ERROR=0
+3 FOR
SET FN=$ORDER(INPUTS(FN))
if FN'>0!(ERROR=1)
QUIT
Begin DoDot:1
+4 SET NUMF=0
+5 SET ID=""
FOR
SET ID=$ORDER(INPUTS(FN,ID))
if ID=""!(ERROR=1)
QUIT
Begin DoDot:2
+6 SET IEN=$SELECT(+ID>0:+ID,1:$$EXISTS^PXRMEXIU(FN,ID))
+7 IF IEN=0
SET ERROR=1
QUIT
+8 SET NUMF=NUMF+1
+9 SET SELLIST(FN,NUMF)=IEN
+10 SET SELLIST(FN,"IEN",NUMF)=NUMF
End DoDot:2
End DoDot:1
+11 IF ERROR=1
QUIT 0
+12 QUIT 1
+13 ;
+14 ;==========================
CRE(EXNAME,INPUTS,DESCTXT,NOTINLM) ;Pack a reminder component and store it in the repository.
+1 NEW CMPLIST,CNT,DIEN,DERRFND,DERRMSG,EFNAME,ERROR,FAIL,FAILTYPE,FILELST
+2 NEW OUTPUT,POA,RANK,SERROR,SELLIST,SUCCESS,TMPIND,USELIST
+3 SET TMPIND="PXRMEXPR"
+4 KILL ^TMP(TMPIND,$JOB)
+5 DO GETFLST(.FILELST)
+6 DO PACKORD^PXRMEXPD(.RANK)
+7 IF '$$BLDFSEL(.SELLIST,.FILELST,.INPUTS)
QUIT
+8 ;
+9 KILL VALMHDR
+10 IF '$DATA(SELLIST)
QUIT
+11 ;Save the user's selections.
+12 MERGE USELIST=SELLIST
+13 ;Process the selected list to build a complete list of components
+14 ;to be packed.
+15 DO CMPLIST^PXRMEXPD(.CMPLIST,.SELLIST,.FILELST,.ERROR)
+16 IF ERROR
KILL ^TMP(TMPIND,$JOB)
QUIT
+17 SET NOTINLM=$GET(NOTINLM)
+18 IF '$$DEF(.SELLIST,TMPIND,NOTINLM)
QUIT
+19 IF '$$TERM(.SELLIST,TMPIND,NOTINLM)
QUIT
+20 IF '$$DIALOG(.SELLIST,TMPIND,NOTINLM)
QUIT
+21 ;
+22 ;Create the header information.
+23 SET EFNAME=$SELECT($GET(EXNAME)'="":EXNAME,1:"")
+24 SET NOTINLM=$GET(NOTINLM)
+25 DO HEADER(TMPIND,.USELIST,.SELLIST,.RANK,EXNAME,.DESCTXT)
+26 IF EXNAME=-1
QUIT
+27 ;
+28 ;Order the component list.
+29 DO ORDER^PXRMEXPD(.CMPLIST,.RANK,.POA)
+30 ;Pack the list
+31 DO PACK^PXRMEXPD(.CMPLIST,.POA,TMPIND,.SELLIST,.SERROR)
+32 IF SERROR
KILL ^TMP(TMPIND,$JOB)
QUIT
+33 DO STOREPR^PXRMEXU2(.SUCCESS,EXNAME,TMPIND,.SELLIST)
+34 KILL ^TMP(TMPIND,$JOB)
+35 IF SUCCESS
Begin DoDot:1
+36 IF +$GET(NOTINLM)
DO BMES^XPDUTL(EFNAME_" was saved in the Exchange File.")
QUIT
+37 SET VALMHDR(1)=EFNAME_" was saved in the Exchange File."
+38 DO BLDLIST^PXRMEXLC(1)
End DoDot:1
+39 IF '$TEST
Begin DoDot:1
+40 IF +$GET(NOTINLM)
Begin DoDot:2
+41 DO BMES^XPDUTL("Creation of Exchange File entry "_EFNAME)
+42 DO BMES^XPDUTL("failed; it was not saved!")
End DoDot:2
QUIT
+43 SET VALMHDR(1)="Creation of Exchange File entry "_EFNAME
+44 SET VALMHDR(2)="failed; it was not saved!"
End DoDot:1
+45 QUIT
+46 ;
DEF(SELLIST,TMPIND,NOTINLM) ;Check reminder definitions for errors.
+1 NEW DIEN,FAIL,IDX,OK,OUTPUT
+2 SET FAIL=0
+3 IF $DATA(SELLIST(811.9))
Begin DoDot:1
+4 ;Check each reminder definition.
+5 IF 'NOTINLM
WRITE !!,"Checking reminder definition(s) for errors."
+6 SET IDX=0
+7 FOR
SET IDX=$ORDER(SELLIST(811.9,"IEN",IDX))
if IDX'>0
QUIT
Begin DoDot:2
+8 SET DIEN=+$GET(SELLIST(811.9,IDX))
IF DIEN=0
QUIT
+9 IF 'NOTINLM
WRITE !!,"Checking reminder definition "_$PIECE(^PXD(811.9,DIEN,0),U,1)
+10 KILL OUTPUT
+11 SET OK=$$DEF^PXRMICHK(DIEN,.OUTPUT,$SELECT(NOTINLM=1:0,1:1))
+12 IF OK=0
SET FAIL=1
End DoDot:2
End DoDot:1
IF FAIL
KILL ^TMP(TMPIND,$JOB)
QUIT 0
+13 IF NOTINLM
QUIT $SELECT(FAIL=1:0,1:1)
+14 IF FAIL=0
WRITE !!,"No fatal reminder definition problems were found, packing will continue."
+15 IF FAIL=1
WRITE !!,"Cannot create the packed file, please correct the above fatal error(s)."
+16 HANG 3
+17 QUIT 1
+18 ;
DIALOG(SELLIST,TMPIND,NOTINLM) ;Check reminder dialogs for errors
+1 NEW CNT,DIEN,FAIL,IDX,OUTPUT,FAILTYPE
+2 SET FAIL=0
+3 KILL OUTPUT
+4 IF $DATA(SELLIST(801.41))
Begin DoDot:1
+5 IF 'NOTINLM
WRITE !!,"Checking reminder dialog(s) for errors."
+6 SET IDX=0
+7 ;Check individual reminder dialogs
+8 FOR
SET IDX=$ORDER(SELLIST(801.41,"IEN",IDX))
if IDX'>0
QUIT
Begin DoDot:2
+9 SET DIEN=+$GET(SELLIST(801.41,IDX))
IF DIEN=0
QUIT
+10 IF FAIL=0
WRITE "."
+11 SET FAILTYPE=$$RETARR^PXRMDLRP(DIEN,.OUTPUT)
if '$DATA(OUTPUT)
QUIT
+12 IF FAILTYPE="F"
SET FAIL="F"
+13 IF FAILTYPE="W"
IF FAIL=0
SET FAIL="W"
+14 IF 'NOTINLM
Begin DoDot:3
+15 WRITE !!,$SELECT(FAILTYPE="W":"**WARNING**",FAILTYPE="F":"**FATAL ERROR**",1:"")
+16 SET CNT=0
FOR
SET CNT=$ORDER(OUTPUT(CNT))
if CNT'>0
QUIT
WRITE !,OUTPUT(CNT)
End DoDot:3
+17 KILL OUTPUT
End DoDot:2
+18 ;
End DoDot:1
IF FAIL="F"
KILL ^TMP(TMPIND,$JOB)
QUIT 0
+19 IF NOTINLM
QUIT $SELECT(FAIL=1:0,1:1)
+20 IF FAIL=0
WRITE !!,"No fatal dialog problems were found, packing will continue."
+21 IF FAIL="F"
WRITE !!,"Cannot create the packed file, please correct the above fatal error(s)."
+22 HANG 3
+23 QUIT 1
+24 ;
GETFLST(FILELST) ;
+1 SET FILELST(1)=811.4_U_$$GET1^DID(811.4,"","","NAME")
+2 SET FILELST(2)=810.8_U_$$GET1^DID(810.8,"","","NAME")
+3 SET FILELST(3)=811.9_U_$$GET1^DID(811.9,"","","NAME")
+4 SET FILELST(4)=801.41_U_$$GET1^DID(801.41,"","","NAME")
+5 SET FILELST(5)=810.7_U_$$GET1^DID(810.7,"","","NAME")
+6 SET FILELST(6)=810.2_U_$$GET1^DID(810.2,"","","NAME")
+7 SET FILELST(7)=810.4_U_$$GET1^DID(810.4,"","","NAME")
+8 SET FILELST(8)=810.9_U_$$GET1^DID(810.9,"","","NAME")
+9 SET FILELST(9)=811.3_U_$$GET1^DID(811.3,"","","NAME")
+10 SET FILELST(10)=811.6_U_$$GET1^DID(811.6,"","","NAME")
+11 SET FILELST(11)=811.2_U_$$GET1^DID(811.2,"","","NAME")
+12 SET FILELST(12)=811.5_U_$$GET1^DID(811.5,"","","NAME")
+13 SET FILELST(13)=801_U_$$GET1^DID(801,"","","NAME")
+14 SET FILELST(14)=801.1_U_$$GET1^DID(801.1,"","","NAME")
+15 SET FILELST(0)=14
+16 QUIT
+17 ;
+18 ;==========================
+1 ;information.
+2 ;Save the source information and the passed in description text.
+3 DO PUTSRC^PXRMEXPD("",EFNAME,TMPIND)
+4 DO BLDDESC(TMPIND,.DESCTXT)
+5 ;Add the packing attributes.
+6 DO PATTR^PXRMEXPD(TMPIND)
+7 QUIT
+8 ;
TERM(SELLIST,TMPIND,NOTINLM) ;Check reminder terms for errors.
+1 NEW DIEN,FAIL,IDX,OK,OUTPUT
+2 SET FAIL=0
+3 IF $DATA(SELLIST(811.5))
Begin DoDot:1
+4 ;Check each reminder term.
+5 IF 'NOTINLM
WRITE !!,"Checking reminder term(s) for errors."
+6 SET IDX=0
+7 FOR
SET IDX=$ORDER(SELLIST(811.5,"IEN",IDX))
if IDX'>0
QUIT
Begin DoDot:2
+8 SET DIEN=+$GET(SELLIST(811.5,IDX))
IF DIEN=0
QUIT
+9 IF 'NOTINLM
WRITE !!,"Checking reminder term "_$PIECE(^PXRMD(811.5,DIEN,0),U,1)
+10 KILL OUTPUT
+11 SET OK=$$TERM^PXRMICK1(DIEN,.OUTPUT,$SELECT(NOTINLM=1:0,1:1))
+12 IF OK=0
SET FAIL=1
End DoDot:2
End DoDot:1
IF FAIL
KILL ^TMP(TMPIND,$JOB)
QUIT 0
+13 IF NOTINLM
QUIT $SELECT(FAIL=1:0,1:1)
+14 IF FAIL=0
WRITE !!,"No fatal reminder term problems were found, packing will continue."
+15 IF FAIL=1
WRITE !!,"Cannot create the packed file, please correct the above fatal error(s)."
+16 HANG 3
+17 QUIT $SELECT(FAIL=1:0,1:1)
+18 ;
