PXRMICK1 ;SLC/PKR - Integrity checking routines continue. ;07/31/2020
;;2.0;CLINICAL REMINDERS;**45,42**;Feb 04, 2005;Build 245
;
;===============
OUTPUT(NOUT,TEXT) ;Output TEXT array.
I $G(PXRMDONE) Q
N ANS,EXIT,IND
S EXIT=0
F IND=1:1:NOUT D
. W !,TEXT(IND)
. I ($Y+2>IOSL),$E(IOST,1,2)="C-" D
.. W !,"Press ENTER to continue or '^' to exit: "
.. R ANS:DTIME
.. S EXIT=('$T)!(ANS="^")
.. I 'EXIT W #
. I EXIT Q
I EXIT S PXRMDONE=1
Q
;
;===============
TERM(IEN,OUTPUT,WRITE) ;Definition integrity check. 0 is returned if the
;definition has fatal errors, otherwise 1 is returned.
;Warning and error text is stored in the OUTPUT array. If WRITE=1 then
;the contents of OUTPUT will be written out.
N OK,NL
S NL=0
S OK=$$TERMCHK^PXRMICK1("",IEN,.NL,.OUTPUT)
I OK S TEXT(1)="No fatal term errors were found."
E S TEXT(1)="This term has fatal errors and it will not work!"
D ADDTEXT^PXRMICHK(1,.TEXT,.NL,.OUTPUT)
I WRITE=1 D OUTPUT^PXRMICK1(NL,.OUTPUT)
Q OK
;
;===============
TERMCHK(USAGE,TIEN,NL,OUTPUT) ;Check terms.
;TERMCHK(USAGE,TIEN,DEFARR,NL,OUTPUT) ;Check terms.
N FI,FIEN,FNUM,GBL,JND,OK,TERMARR,TEXT,TNAME,TTEXT,ZNODE
I '$D(^PXRMD(811.5,TIEN)) D Q 0
. S TEXT(1)="FATAL: Term IEN="_TIEN_" does not exist."
. D ADDTEXT^PXRMICHK(1,.TEXT,.NL,.OUTPUT)
S TNAME=$P(^PXRMD(811.5,TIEN,0),U,1)_" ("_TIEN_")"
S TTEXT=" The term is "_TNAME_"."
S OK=1
D TERM^PXRMLDR(TIEN,.TERMARR)
;Check findings and finding modifiers.
S JND=0
F S JND=+$O(TERMARR(20,JND)) Q:JND=0 D
. S ZNODE=TERMARR(20,JND,0)
. S FI=$P(ZNODE,U,1)
. S FIEN=$P(FI,";",1)
. S GBL=$P(FI,";",2)
. I (FIEN'=+FIEN)!(GBL="") D Q
.. K TEXT
.. S TEXT(1)="FATAL: Term finding number "_JND_" is invalid."
.. S TEXT(2)=TTEXT
.. D ADDTEXT^PXRMICHK(2,.TEXT,.NL,.OUTPUT)
.. S OK=0
. S FNUM=$$GETFNUM^PXRMEXPS(GBL)
. I '$$FIND1^DIC(FNUM,"","XU","`"_FIEN) D
.. K TEXT
.. S TEXT(1)="FATAL: Term finding number "_JND_", does not exist! It is entry number "_FIEN_" in file #"_FNUM_"."
.. S TEXT(2)=TTEXT
.. D ADDTEXT^PXRMICHK(2,.TEXT,.NL,.OUTPUT)
.. S OK=0
.;Check computed findings.
. I (GBL="PXRMD(811.4,"),'$$CFCHK^PXRMICHK(USAGE,JND,FIEN,.TERMARR,"T",.NL,.OUTPUT) D
..;CFCHK issues the messages for the CF, let the user know the name
..;of the term.
.. K TEXT
.. S TEXT(1)=TTEXT
.. D ADDTEXT^PXRMICHK(1,.TEXT,.NL,.OUTPUT)
.. S OK=0
Q OK
;
;===============
TCHKALL ;Check all terms.
N IEN,NAME,OK,OUTPUT,POP,PXRMDONE,TEXT
W #!,"Check the integrity of all reminder terms."
D ^%ZIS Q:POP
U IO
S NAME="",PXRMDONE=0
F S NAME=$O(^PXRMD(811.5,"B",NAME)) Q:(NAME="")!(PXRMDONE) D
. S IEN=$O(^PXRMD(811.5,"B",NAME,""))
. W !!,"Checking "_NAME_" (IEN="_IEN_")"
. K OUTPUT
. S OK=$$TERM^PXRMICK1(IEN,.OUTPUT,1)
D ^%ZISC
Q
;
;===============
TCHKONE ;Check selected terms.
N DIC,DTOUT,DUOUT,IEN,OK,OUTPUT,Y
S DIC="^PXRMD(811.5,"
S DIC(0)="AEMQ"
S DIC("A")="Select Reminder Term: "
GETTERM ;Get the term to check.
W !
D ^DIC
I ($D(DTOUT))!($D(DUOUT)) Q
I Y=-1 Q
S IEN=$P(Y,U,1)
W #
K OUTPUT
S OK=$$TERM^PXRMICK1(IEN,.OUTPUT,1)
G GETTERM
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMICK1 3190 printed Nov 22, 2024@16:56:19 Page 2
PXRMICK1 ;SLC/PKR - Integrity checking routines continue. ;07/31/2020
+1 ;;2.0;CLINICAL REMINDERS;**45,42**;Feb 04, 2005;Build 245
+2 ;
+3 ;===============
OUTPUT(NOUT,TEXT) ;Output TEXT array.
+1 IF $GET(PXRMDONE)
QUIT
+2 NEW ANS,EXIT,IND
+3 SET EXIT=0
+4 FOR IND=1:1:NOUT
Begin DoDot:1
+5 WRITE !,TEXT(IND)
+6 IF ($Y+2>IOSL)
IF $EXTRACT(IOST,1,2)="C-"
Begin DoDot:2
+7 WRITE !,"Press ENTER to continue or '^' to exit: "
+8 READ ANS:DTIME
+9 SET EXIT=('$TEST)!(ANS="^")
+10 IF 'EXIT
WRITE #
End DoDot:2
+11 IF EXIT
QUIT
End DoDot:1
+12 IF EXIT
SET PXRMDONE=1
+13 QUIT
+14 ;
+15 ;===============
TERM(IEN,OUTPUT,WRITE) ;Definition integrity check. 0 is returned if the
+1 ;definition has fatal errors, otherwise 1 is returned.
+2 ;Warning and error text is stored in the OUTPUT array. If WRITE=1 then
+3 ;the contents of OUTPUT will be written out.
+4 NEW OK,NL
+5 SET NL=0
+6 SET OK=$$TERMCHK^PXRMICK1("",IEN,.NL,.OUTPUT)
+7 IF OK
SET TEXT(1)="No fatal term errors were found."
+8 IF '$TEST
SET TEXT(1)="This term has fatal errors and it will not work!"
+9 DO ADDTEXT^PXRMICHK(1,.TEXT,.NL,.OUTPUT)
+10 IF WRITE=1
DO OUTPUT^PXRMICK1(NL,.OUTPUT)
+11 QUIT OK
+12 ;
+13 ;===============
TERMCHK(USAGE,TIEN,NL,OUTPUT) ;Check terms.
+1 ;TERMCHK(USAGE,TIEN,DEFARR,NL,OUTPUT) ;Check terms.
+2 NEW FI,FIEN,FNUM,GBL,JND,OK,TERMARR,TEXT,TNAME,TTEXT,ZNODE
+3 IF '$DATA(^PXRMD(811.5,TIEN))
Begin DoDot:1
+4 SET TEXT(1)="FATAL: Term IEN="_TIEN_" does not exist."
+5 DO ADDTEXT^PXRMICHK(1,.TEXT,.NL,.OUTPUT)
End DoDot:1
QUIT 0
+6 SET TNAME=$PIECE(^PXRMD(811.5,TIEN,0),U,1)_" ("_TIEN_")"
+7 SET TTEXT=" The term is "_TNAME_"."
+8 SET OK=1
+9 DO TERM^PXRMLDR(TIEN,.TERMARR)
+10 ;Check findings and finding modifiers.
+11 SET JND=0
+12 FOR
SET JND=+$ORDER(TERMARR(20,JND))
if JND=0
QUIT
Begin DoDot:1
+13 SET ZNODE=TERMARR(20,JND,0)
+14 SET FI=$PIECE(ZNODE,U,1)
+15 SET FIEN=$PIECE(FI,";",1)
+16 SET GBL=$PIECE(FI,";",2)
+17 IF (FIEN'=+FIEN)!(GBL="")
Begin DoDot:2
+18 KILL TEXT
+19 SET TEXT(1)="FATAL: Term finding number "_JND_" is invalid."
+20 SET TEXT(2)=TTEXT
+21 DO ADDTEXT^PXRMICHK(2,.TEXT,.NL,.OUTPUT)
+22 SET OK=0
End DoDot:2
QUIT
+23 SET FNUM=$$GETFNUM^PXRMEXPS(GBL)
+24 IF '$$FIND1^DIC(FNUM,"","XU","`"_FIEN)
Begin DoDot:2
+25 KILL TEXT
+26 SET TEXT(1)="FATAL: Term finding number "_JND_", does not exist! It is entry number "_FIEN_" in file #"_FNUM_"."
+27 SET TEXT(2)=TTEXT
+28 DO ADDTEXT^PXRMICHK(2,.TEXT,.NL,.OUTPUT)
+29 SET OK=0
End DoDot:2
+30 ;Check computed findings.
+31 IF (GBL="PXRMD(811.4,")
IF '$$CFCHK^PXRMICHK(USAGE,JND,FIEN,.TERMARR,"T",.NL,.OUTPUT)
Begin DoDot:2
+32 ;CFCHK issues the messages for the CF, let the user know the name
+33 ;of the term.
+34 KILL TEXT
+35 SET TEXT(1)=TTEXT
+36 DO ADDTEXT^PXRMICHK(1,.TEXT,.NL,.OUTPUT)
+37 SET OK=0
End DoDot:2
End DoDot:1
+38 QUIT OK
+39 ;
+40 ;===============
TCHKALL ;Check all terms.
+1 NEW IEN,NAME,OK,OUTPUT,POP,PXRMDONE,TEXT
+2 WRITE #!,"Check the integrity of all reminder terms."
+3 DO ^%ZIS
if POP
QUIT
+4 USE IO
+5 SET NAME=""
SET PXRMDONE=0
+6 FOR
SET NAME=$ORDER(^PXRMD(811.5,"B",NAME))
if (NAME="")!(PXRMDONE)
QUIT
Begin DoDot:1
+7 SET IEN=$ORDER(^PXRMD(811.5,"B",NAME,""))
+8 WRITE !!,"Checking "_NAME_" (IEN="_IEN_")"
+9 KILL OUTPUT
+10 SET OK=$$TERM^PXRMICK1(IEN,.OUTPUT,1)
End DoDot:1
+11 DO ^%ZISC
+12 QUIT
+13 ;
+14 ;===============
TCHKONE ;Check selected terms.
+1 NEW DIC,DTOUT,DUOUT,IEN,OK,OUTPUT,Y
+2 SET DIC="^PXRMD(811.5,"
+3 SET DIC(0)="AEMQ"
+4 SET DIC("A")="Select Reminder Term: "
GETTERM ;Get the term to check.
+1 WRITE !
+2 DO ^DIC
+3 IF ($DATA(DTOUT))!($DATA(DUOUT))
QUIT
+4 IF Y=-1
QUIT
+5 SET IEN=$PIECE(Y,U,1)
+6 WRITE #
+7 KILL OUTPUT
+8 SET OK=$$TERM^PXRMICK1(IEN,.OUTPUT,1)
+9 GOTO GETTERM
+10 QUIT
+11 ;
