PRCTRCH ;WISC@ALTOONA/RGY-HANDLE INTEGRITY CHECK OF REPORT ;01 Jun 90/3:57 PM
;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
S ERR=0 I '$D(^PRCT(446.5,DA,0)) S ERR=1 G Q
S N0=^PRCT(446.5,DA,0) I $P(N0,"^")="" S ERR=1 W *7,!,"Error, name of report is null"
I $P(N0,"^",2),'$D(^DIC($P(N0,"^",2),0)) S ERR=1 W *7,!,"Error, FILE defined for this entry does not exist"
I '$O(^PRCT(446.5,DA,1,0)) W *7,!,"Error, no report text exists!" S ERR=1
F X=0:0 S X=$O(^PRCT(446.5,DA,1,X)) Q:'X D LNCH
F X=0:0 S X=$O(^PRCT(446.5,DA,2,X)) Q:'X D PCH
Q K PRCTE,FL,PRCT,N0 Q
LNCH S Y=^PRCT(446.5,DA,1,X,0) I $L(Y,"|")-1#2 W *7,!,"Report TEXT line #",X," parameter is invalid!" S ERR=1
F PRCT=2:2:$L(Y,"|") I $P(Y,"|",PRCT)'?.N W *7,!,"Parameter in line #",X," is not numeric" S ERR=1
F PRCT=2:2:$L(Y,"|") I '$D(^PRCT(446.5,DA,2,+$P(Y,"|",PRCT),0)) W *7,!,"Parameter #",$P(Y,"|",PRCT)," in line #",X," is not defined" S ERR=1
Q
PCH S Y=^PRCT(446.5,DA,2,X,0) I $P(Y,"^",2)=1,$P(Y,"^",4)="" W *7,!,"Error, parameter #",X," is defined as FIELD, but has no field defined." S ERR=1
I $P(Y,"^",2)=1,$P(N0,"^",2)="" W *7,!,"Error, parameter #",X," is defined as FIELD, but no FILE has been defined." S ERR=1
I $P(Y,"^",2)=1,$P(N0,"^",2) S PRCTE=$P(Y,"^",4),FL=$P(N0,"^",2) F PRCT=0:0 S PRCT=+PRCTE,PRCTE=$P(PRCTE,+PRCTE,2,999) Q:PRCT=0 D FLD Q:'FL S PRCTE=$E(PRCTE,2,999)
I $P(Y,"^",2)=0&($P(Y,"^",7)=""!($P(Y,"^",8)="")) W *7,!,"Error, parameter #",X," is defined as COUNTER, but START and/or INCREMENT",!," ... are not defined" S ERR=1
I $P(Y,"^",2)=2,$S('$D(^PRCT(446.5,DA,2,X,1)):1,^(1)="":1,1:0) W *7,!,"Error, parameter #",X," is defined as XECUTABLE CODE, but no CODE has",!," ... been defined!" S ERR=1
Q
FLD ;
I $S($D(^DD(FL,PRCT,0)):0,1:1) S ERR=1 W *7,!,"Field in parameter ",X," does not exist in file specified" S FL=0 Q
I $E(PRCTE)]"" S FL=$S($E(PRCTE)=":":+$P($P(^DD(FL,PRCT,0),"^",2),"P",2),1:+$P(^(0),"^",2)) I 'FL S ERR=1 W *7,!,"An invalid field exists for parameter #",X
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCTRCH 2061 printed Dec 13, 2024@02:19:24 Page 2
PRCTRCH ;WISC@ALTOONA/RGY-HANDLE INTEGRITY CHECK OF REPORT ;01 Jun 90/3:57 PM
+1 ;;5.1;IFCAP;;Oct 20, 2000
+2 ;Per VHA Directive 10-93-142, this routine should not be modified.
+3 SET ERR=0
IF '$DATA(^PRCT(446.5,DA,0))
SET ERR=1
GOTO Q
+4 SET N0=^PRCT(446.5,DA,0)
IF $PIECE(N0,"^")=""
SET ERR=1
WRITE *7,!,"Error, name of report is null"
+5 IF $PIECE(N0,"^",2)
IF '$DATA(^DIC($PIECE(N0,"^",2),0))
SET ERR=1
WRITE *7,!,"Error, FILE defined for this entry does not exist"
+6 IF '$ORDER(^PRCT(446.5,DA,1,0))
WRITE *7,!,"Error, no report text exists!"
SET ERR=1
+7 FOR X=0:0
SET X=$ORDER(^PRCT(446.5,DA,1,X))
if 'X
QUIT
DO LNCH
+8 FOR X=0:0
SET X=$ORDER(^PRCT(446.5,DA,2,X))
if 'X
QUIT
DO PCH
Q KILL PRCTE,FL,PRCT,N0
QUIT
LNCH SET Y=^PRCT(446.5,DA,1,X,0)
IF $LENGTH(Y,"|")-1#2
WRITE *7,!,"Report TEXT line #",X," parameter is invalid!"
SET ERR=1
+1 FOR PRCT=2:2:$LENGTH(Y,"|")
IF $PIECE(Y,"|",PRCT)'?.N
WRITE *7,!,"Parameter in line #",X," is not numeric"
SET ERR=1
+2 FOR PRCT=2:2:$LENGTH(Y,"|")
IF '$DATA(^PRCT(446.5,DA,2,+$PIECE(Y,"|",PRCT),0))
WRITE *7,!,"Parameter #",$PIECE(Y,"|",PRCT)," in line #",X," is not defined"
SET ERR=1
+3 QUIT
PCH SET Y=^PRCT(446.5,DA,2,X,0)
IF $PIECE(Y,"^",2)=1
IF $PIECE(Y,"^",4)=""
WRITE *7,!,"Error, parameter #",X," is defined as FIELD, but has no field defined."
SET ERR=1
+1 IF $PIECE(Y,"^",2)=1
IF $PIECE(N0,"^",2)=""
WRITE *7,!,"Error, parameter #",X," is defined as FIELD, but no FILE has been defined."
SET ERR=1
+2 IF $PIECE(Y,"^",2)=1
IF $PIECE(N0,"^",2)
SET PRCTE=$PIECE(Y,"^",4)
SET FL=$PIECE(N0,"^",2)
FOR PRCT=0:0
SET PRCT=+PRCTE
SET PRCTE=$PIECE(PRCTE,+PRCTE,2,999)
if PRCT=0
QUIT
DO FLD
if 'FL
QUIT
SET PRCTE=$EXTRACT(PRCTE,2,999)
+3 IF $PIECE(Y,"^",2)=0&($PIECE(Y,"^",7)=""!($PIECE(Y,"^",8)=""))
WRITE *7,!,"Error, parameter #",X," is defined as COUNTER, but START and/or INCREMENT",!," ... are not defined"
SET ERR=1
+4 IF $PIECE(Y,"^",2)=2
IF $SELECT('$DATA(^PRCT(446.5,DA,2,X,1)):1,^(1)="":1,1:0)
WRITE *7,!,"Error, parameter #",X," is defined as XECUTABLE CODE, but no CODE has",!," ... been defined!"
SET ERR=1
+5 QUIT
FLD ;
+1 IF $SELECT($DATA(^DD(FL,PRCT,0)):0,1:1)
SET ERR=1
WRITE *7,!,"Field in parameter ",X," does not exist in file specified"
SET FL=0
QUIT
+2 IF $EXTRACT(PRCTE)]""
SET FL=$SELECT($EXTRACT(PRCTE)=":":+$PIECE($PIECE(^DD(FL,PRCT,0),"^",2),"P",2),1:+$PIECE(^(0),"^",2))
IF 'FL
SET ERR=1
WRITE *7,!,"An invalid field exists for parameter #",X
+3 QUIT
