- AZHLSCFV ; IHS/ADC/GTH:KEU - DSM QABLE FIELD VERIFIER ;
- ;;5.0;AZHLSC;;JUL 10, 1996
- ;
- NEW A,AZHLFLDS,AZHLNMSP,DIC,DA,DDC,DE,DG,DIFLD,DIR,DIRUT,DISYS,DIU,DQ,DQI,DR,D0,B,C,D,E,F,G,I,J,L,N,P,Q,S,T,V,W,Z
- ;
- S:'$D(DTIME) DTIME=300
- 0 W !!!?4,$P($P($T(@"AZHLSCFV"),";",2),"-",2)," v ",$P($T(@"AZHLSCFV"+1),";",3),!
- W !! S DIC="^DIC(",DIC(0)="QAZEM" D ^DIC G:Y<0 Q S A=+Y,AZHLNMSP=$P(^DIC(A,0),U),DIU=^(0,"GL")
- ;
- K J
- S Q="""",S=";",V=0,P=0,I(0)=DIU,@("(A,J(0))=+$P("_DIU_"0),U,2)")
- I $O(^(0))'>0 W *7," NO ENTRIES ON FILE!" Q
- DIC S DIC="^DD(A,",DIC(0)="EZ",DIC("W")="W:$P(^(0),U,2) "" (multiple)"""
- S DIC("S")="S %=$P(^(0),U,2) I %'[""C"",$S('%:1,1:$P(^DD(+%,.01,0),U,2)'[""W"")"
- W !,"VERIFY WHICH "_$P(^DD(A,0),U)_": " R X:DTIME Q:U[X
- I X="ALL" D ALL^DIV G Q:$D(DIRUT) I Y S AZHLFLDS="ALL" G DEVICE
- D ^DIC K DQI,^UTILITY("DIVR",$J)
- I Y<0 W:X?1."?" !?3,"You may enter ALL to verify every field at this level of the file.",! G DIC
- S DR=$P(Y(0),U,2) I DR S J(V)=A,P=+Y,V=V+1,A=+DR,I(V)=$P($P(Y(0),U,4),S,1) S:+I(V)'=I(V) I(V)=Q_I(V)_Q G DIC
- S AZHLFLDS=X
- ;
- ;
- DEVICE W !!,"Report will be QUEUE'd if device other than HOME selected.",! K IOP,%ZIS S %ZIS="NQM",%ZIS("B")="" D ^%ZIS K %ZIS I POP W !,*7,"No device specified." G Q
- S IOP=ION_";"_IOST_$S($D(IO("DOC")):";"_IO("DOC"),1:";"_IOM_";"_IOSL)
- I IO=IO(0),"C"[$E(IOST),$D(IO("Q"))#2 W !,"Can't Q to home device." K IO("Q") G DEVICE
- I IO'=IO(0),'$D(IO("Q")) W !!,"Report being QUEUE'd to run now for you." S IO("Q")=1,ZTDTH=$H
- I '$D(IO("Q")) D ^%ZIS G START
- S ZTRTN="START^AZHLSCFV",ZTIO=IOP,ZTDESC="FIELD VERIFICATION of "_AZHLNMSP_" file." S ZTSAVE("*")=""
- K IO("Q") D ^%ZTLOAD D HOME^%ZIS
- DEVEND K IOP,ZTSK G Q
- START ;EP - From TaskMan.
- S X="QEND^AZHLSCFV",@^%ZOSF("TRAP")
- U IO W !!,"<<<<<<< DSM QABLE FIELD VERIFIER >>>>>>>",!,"File : ",AZHLNMSP," (",$S($D(^DIC(A,0,"GL")):^("GL"),1:A),")",! D BEG^AZHLSC
- I AZHLFLDS="ALL" F DQI=0:0 S DQI=$O(^DD(A,DQI)) G QEND:DQI'>0 S Y=DQI,Y(0)=^(Y,0),DR=$P(Y(0),U,2) I 'DR,DR'["C" W !!,"--",$P(Y(0),U),"--" D 1
- S Y=$O(^DD(A,"B",AZHLFLDS,0))
- 1 F T="N","D","P","S","V","F" Q:DR[T
- F W="FREE TEXT","SET OF CODES","DATE","NUMERIC","POINTER","VARIABLE POINTER","K" I T[$E(W) S:W="K" W="MUMPS" W " ",W
- K DA S Z=$P(Y(0),U,3),DDC=$P(Y(0),U,5,99),(DIFLD,DA)=+Y
- D ^DIVR
- Q:AZHLFLDS="ALL"
- QEND ;EP - If error, probable for NODEV at Q+1^DIVR.
- S X="^%ET",@^%ZOSF("TRAP")
- W !!!,"<< DSM QABLE FIELD VERIFIER >>" D FIN^AZHLSC
- I $D(ZTQUEUED) Q
- D Q
- G 0
- Q K DIR,DIRUT,N,P,Q,S,V,C
- Q
- AZHLSCFV ; IHS/ADC/GTH:KEU - DSM QABLE FIELD VERIFIER ;
- +1 ;;5.0;AZHLSC;;JUL 10, 1996
- +2 ;
- +3 NEW A,AZHLFLDS,AZHLNMSP,DIC,DA,DDC,DE,DG,DIFLD,DIR,DIRUT,DISYS,DIU,DQ,DQI,DR,D0,B,C,D,E,F,G,I,J,L,N,P,Q,S,T,V,W,Z
- +4 ;
- +5 IF '$DATA(DTIME)
- SET DTIME=300
- 0 WRITE !!!?4,$PIECE($PIECE($TEXT(@"AZHLSCFV"),";",2),"-",2)," v ",$PIECE($TEXT(@"AZHLSCFV"+1),";",3),!
- +1 WRITE !!
- SET DIC="^DIC("
- SET DIC(0)="QAZEM"
- DO ^DIC
- IF Y<0
- GOTO Q
- SET A=+Y
- SET AZHLNMSP=$PIECE(^DIC(A,0),U)
- SET DIU=^(0,"GL")
- +2 ;
- +3 KILL J
- +4 SET Q=""""
- SET S=";"
- SET V=0
- SET P=0
- SET I(0)=DIU
- SET @("(A,J(0))=+$P("_DIU_"0),U,2)")
- +5 IF $ORDER(^(0))'>0
- WRITE *7," NO ENTRIES ON FILE!"
- QUIT
- DIC SET DIC="^DD(A,"
- SET DIC(0)="EZ"
- SET DIC("W")="W:$P(^(0),U,2) "" (multiple)"""
- +1 SET DIC("S")="S %=$P(^(0),U,2) I %'[""C"",$S('%:1,1:$P(^DD(+%,.01,0),U,2)'[""W"")"
- +2 WRITE !,"VERIFY WHICH "_$PIECE(^DD(A,0),U)_": "
- READ X:DTIME
- IF U[X
- QUIT
- +3 IF X="ALL"
- DO ALL^DIV
- IF $DATA(DIRUT)
- GOTO Q
- IF Y
- SET AZHLFLDS="ALL"
- GOTO DEVICE
- +4 DO ^DIC
- KILL DQI,^UTILITY("DIVR",$JOB)
- +5 IF Y<0
- IF X?1."?"
- WRITE !?3,"You may enter ALL to verify every field at this level of the file.",!
- GOTO DIC
- +6 SET DR=$PIECE(Y(0),U,2)
- IF DR
- SET J(V)=A
- SET P=+Y
- SET V=V+1
- SET A=+DR
- SET I(V)=$PIECE($PIECE(Y(0),U,4),S,1)
- IF +I(V)'=I(V)
- SET I(V)=Q_I(V)_Q
- GOTO DIC
- +7 SET AZHLFLDS=X
- +8 ;
- +9 ;
- DEVICE WRITE !!,"Report will be QUEUE'd if device other than HOME selected.",!
- KILL IOP,%ZIS
- SET %ZIS="NQM"
- SET %ZIS("B")=""
- DO ^%ZIS
- KILL %ZIS
- IF POP
- WRITE !,*7,"No device specified."
- GOTO Q
- +1 SET IOP=ION_";"_IOST_$SELECT($DATA(IO("DOC")):";"_IO("DOC"),1:";"_IOM_";"_IOSL)
- +2 IF IO=IO(0)
- IF "C"[$EXTRACT(IOST)
- IF $DATA(IO("Q"))#2
- WRITE !,"Can't Q to home device."
- KILL IO("Q")
- GOTO DEVICE
- +3 IF IO'=IO(0)
- IF '$DATA(IO("Q"))
- WRITE !!,"Report being QUEUE'd to run now for you."
- SET IO("Q")=1
- SET ZTDTH=$HOROLOG
- +4 IF '$DATA(IO("Q"))
- DO ^%ZIS
- GOTO START
- +5 SET ZTRTN="START^AZHLSCFV"
- SET ZTIO=IOP
- SET ZTDESC="FIELD VERIFICATION of "_AZHLNMSP_" file."
- SET ZTSAVE("*")=""
- +6 KILL IO("Q")
- DO ^%ZTLOAD
- DO HOME^%ZIS
- DEVEND KILL IOP,ZTSK
- GOTO Q
- START ;EP - From TaskMan.
- +1 SET X="QEND^AZHLSCFV"
- SET @^%ZOSF("TRAP")
- +2 USE IO
- WRITE !!,"<<<<<<< DSM QABLE FIELD VERIFIER >>>>>>>",!,"File : ",AZHLNMSP," (",$SELECT($DATA(^DIC(A,0,"GL")):^("GL"),1:A),")",!
- DO BEG^AZHLSC
- +3 IF AZHLFLDS="ALL"
- FOR DQI=0:0
- SET DQI=$ORDER(^DD(A,DQI))
- IF DQI'>0
- GOTO QEND
- SET Y=DQI
- SET Y(0)=^(Y,0)
- SET DR=$PIECE(Y(0),U,2)
- IF 'DR
- IF DR'["C"
- WRITE !!,"--",$PIECE(Y(0),U),"--"
- DO 1
- +4 SET Y=$ORDER(^DD(A,"B",AZHLFLDS,0))
- 1 FOR T="N","D","P","S","V","F"
- IF DR[T
- QUIT
- +1 FOR W="FREE TEXT","SET OF CODES","DATE","NUMERIC","POINTER","VARIABLE POINTER","K"
- IF T[$EXTRACT(W)
- IF W="K"
- SET W="MUMPS"
- WRITE " ",W
- +2 KILL DA
- SET Z=$PIECE(Y(0),U,3)
- SET DDC=$PIECE(Y(0),U,5,99)
- SET (DIFLD,DA)=+Y
- +3 DO ^DIVR
- +4 IF AZHLFLDS="ALL"
- QUIT
- QEND ;EP - If error, probable for NODEV at Q+1^DIVR.
- +1 SET X="^%ET"
- SET @^%ZOSF("TRAP")
- +2 WRITE !!!,"<< DSM QABLE FIELD VERIFIER >>"
- DO FIN^AZHLSC
- +3 IF $DATA(ZTQUEUED)
- QUIT
- +4 DO Q
- +5 GOTO 0
- Q KILL DIR,DIRUT,N,P,Q,S,V,C
- +1 QUIT