- XDRDPREL ;SF-IRMFO.SEA/JLI - PRELIMINARY IDENTIFICATION OF ENTRIES WITH BAD DATA ;9/19/96 09:19
- ;;7.3;TOOLKIT;**23**;Apr 25, 1995
- ;;
- ;;
- EN ;
- S XDRFL=+$$FILE^XDRDPICK() G:XDRFL'>0 EXIT S XDRFNAM=$P(^DIC(XDRFL,0),U)
- I $D(^XTMP("XDRDPREL",XDRFL," DONE")) D Q:XDRFL=0 I 1
- . W !!,"A run was completed on "_$$HTE^XLFDT(^XTMP("XDRDPREL",XDRFL," DONE")),!!
- . S DIR(0)="Y",DIR("A")="Do you want to view those results",DIR("B")="YES" D ^DIR K DIR
- . I Y>0 D
- . . D VIEW(XDRFL)
- . . S XDRFL=0
- E I $D(^XTMP("XDRDPREL",XDRFL," TIME")) D Q:XDRFL=0
- . I $$HDIFF^XLFDT($H,^XTMP("XDRDPREL",XDRFL," TIME"),2)>300 Q
- . W !!,"There appears to be a job already running. You may either"
- . W !,"view those data or check back in about 5 minutes.",!!
- . S DIR(0)="Y",DIR("A")="Do you want to view the running job",DIR("B")="YES" D ^DIR K DIR
- . I Y>0 D VIEW(XDRFL)
- . S XDRFL=0
- S ZTRTN="DQ^XDRDPREL",ZTIO="",ZTSAVE("XDRFL")="",ZTDESC="XDRDPREL - PRELIM SCAN" D ^%ZTLOAD
- I $D(ZTSK) W !!,"Queued as task ",ZTSK,!
- Q
- DQ ;
- S XDRGLB=^DIC(XDRFL,0,"GL")_"XDRDA)"
- S XDRDR=""
- F XDRI=0:0 S XDRI=$O(^DD(XDRFL,0,"ID",XDRI)) Q:XDRI'>0 S XDRDR=XDRDR_XDRI_";"
- S XDRTMP="^XTMP(""XDRDPREL"",XDRFL)"
- K @XDRTMP,XDRNV,XDRN S NTOT=0,@XDRTMP@(" TIME")=$H,@XDRTMP@(" START")=$H
- F XDRDA=0:0 S XDRDA=$O(@XDRGLB) Q:XDRDA'>0 D
- . I $D(@XDRGLB@(-9)) Q
- . S @XDRTMP@(" CURR")=XDRDA,^(" TIME")=$H
- . S NTOT=NTOT+1
- . S @XDRTMP@(" TOTAL")=NTOT
- . I '$D(@XDRGLB@(0)) D Q
- . . S XXX="NO ZERO NODE"
- . . S ^(XXX)=$G(@XDRTMP@(XXX))+1
- . . S @XDRTMP@(XXX,XDRDA)=""
- . I XDRDR'="" D
- . . S DR=XDRDR
- . . S DA=XDRDA,DIC=XDRFL,DIQ(0)="I",DIQ="XDRX" K XDRX
- . . D EN^DIQ1
- . . S N=0
- . . F I=0:0 S I=$O(XDRX(XDRFL,XDRDA,I)) Q:I'>0 D
- . . . I XDRX(XDRFL,XDRDA,I,"I")="" D
- . . . . S N=N+1
- . . . . S XXX="MISSING #"_I
- . . . . S @XDRTMP@(XXX)=$G(@XDRTMP@(XXX))+1
- . . . . S @XDRTMP@(XXX,XDRDA)=""
- . . S XXX=$G(XDRX(XDRFL,XDRDA,$S(XDRFL=2:.09,XDRFL=200:9,1:0),"I"))
- . . I XXX'="" D
- . . . I XXX'?9N.E D
- . . . . S XXX="BAD SSN"
- . . . . S @XDRTMP@(XXX)=$G(@XDRTMP@(XXX))+1
- . . . . S @XDRTMP@(XXX,XDRDA)=""
- . . . . S N=N+1
- . . I N>0 D
- . . . S XXX="MISSING "_N_" VAL"_$S(N>1:"S",1:"")
- . . . S @XDRTMP@(XXX)=$G(@XDRTMP@(XXX))+1
- . . . S @XDRTMP@(XXX,XDRDA)=""
- S @XDRTMP@(" DONE")=$H
- K @XDRTMP@(" TIME")
- Q
- VIEW(XDRFL) ;
- N XDRTMP,X,Y,XTIME
- S XDRTMP="^XTMP(""XDRDPREL"",XDRFL)"
- I '$D(@XDRTMP) Q
- L +@XDRTMP
- S X=""
- F S X=$O(@XDRTMP@(X)) Q:X="" S X(X)=@XDRTMP@(X)
- L -@XDRTMP
- S XRUN=$$HDIFF^XLFDT($S($D(X(" DONE")):X(" DONE"),1:X(" TIME")),X(" START"),2)
- S XTIME=(XRUN\3600)_":"_$S((XRUN#3600\60)<10:"0",1:"")_(XRUN#3600\60)_":"_$S((XRUN#60)<10:"0",1:"")_(XRUN#60)
- W @IOF
- W !!!,"RUN TIME: ",XTIME," CURRENT IEN: ",X(" CURR")," FILE ENTRIES: ",X(" TOTAL")
- W !
- S X="" F S X=$O(X(X)) Q:X="" I X["#" D
- . S Y=+$P(X,"#",2)
- . W !,$J(X(X),10)," ",XDRFNAM," entries are missing field # ",Y," ",$P(^DD(XDRFL,Y,0),U)
- I $D(X("NO ZERO NODE")) W !,$J(X("NO ZERO NODE"),10)," ",XDRFNAM," entries have NO zero node!"
- I $D(X("BAD SSN")) W !,$J(X("BAD SSN"),10)," ",XDRFNAM," entries have bad SSN values (non-numeric, etc.)"
- S X="" W !
- F S X=$O(X(X)) Q:X="" I X["VAL" D
- . S Y=+$P(X," ",2)
- . W !,$J(X(X),10)," ",XDRFNAM," entries are missing ",Y," of the fields above"
- W ! K DIR S DIR(0)="E" D ^DIR K DIR
- Q
- ;
- EXIT Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXDRDPREL 3384 printed Feb 19, 2025@00:05:38 Page 2
- XDRDPREL ;SF-IRMFO.SEA/JLI - PRELIMINARY IDENTIFICATION OF ENTRIES WITH BAD DATA ;9/19/96 09:19
- +1 ;;7.3;TOOLKIT;**23**;Apr 25, 1995
- +2 ;;
- +3 ;;
- EN ;
- +1 SET XDRFL=+$$FILE^XDRDPICK()
- if XDRFL'>0
- GOTO EXIT
- SET XDRFNAM=$PIECE(^DIC(XDRFL,0),U)
- +2 IF $DATA(^XTMP("XDRDPREL",XDRFL," DONE"))
- Begin DoDot:1
- +3 WRITE !!,"A run was completed on "_$$HTE^XLFDT(^XTMP("XDRDPREL",XDRFL," DONE")),!!
- +4 SET DIR(0)="Y"
- SET DIR("A")="Do you want to view those results"
- SET DIR("B")="YES"
- DO ^DIR
- KILL DIR
- +5 IF Y>0
- Begin DoDot:2
- +6 DO VIEW(XDRFL)
- +7 SET XDRFL=0
- End DoDot:2
- End DoDot:1
- if XDRFL=0
- QUIT
- IF 1
- +8 IF '$TEST
- IF $DATA(^XTMP("XDRDPREL",XDRFL," TIME"))
- Begin DoDot:1
- +9 IF $$HDIFF^XLFDT($HOROLOG,^XTMP("XDRDPREL",XDRFL," TIME"),2)>300
- QUIT
- +10 WRITE !!,"There appears to be a job already running. You may either"
- +11 WRITE !,"view those data or check back in about 5 minutes.",!!
- +12 SET DIR(0)="Y"
- SET DIR("A")="Do you want to view the running job"
- SET DIR("B")="YES"
- DO ^DIR
- KILL DIR
- +13 IF Y>0
- DO VIEW(XDRFL)
- +14 SET XDRFL=0
- End DoDot:1
- if XDRFL=0
- QUIT
- +15 SET ZTRTN="DQ^XDRDPREL"
- SET ZTIO=""
- SET ZTSAVE("XDRFL")=""
- SET ZTDESC="XDRDPREL - PRELIM SCAN"
- DO ^%ZTLOAD
- +16 IF $DATA(ZTSK)
- WRITE !!,"Queued as task ",ZTSK,!
- +17 QUIT
- DQ ;
- +1 SET XDRGLB=^DIC(XDRFL,0,"GL")_"XDRDA)"
- +2 SET XDRDR=""
- +3 FOR XDRI=0:0
- SET XDRI=$ORDER(^DD(XDRFL,0,"ID",XDRI))
- if XDRI'>0
- QUIT
- SET XDRDR=XDRDR_XDRI_";"
- +4 SET XDRTMP="^XTMP(""XDRDPREL"",XDRFL)"
- +5 KILL @XDRTMP,XDRNV,XDRN
- SET NTOT=0
- SET @XDRTMP@(" TIME")=$HOROLOG
- SET @XDRTMP@(" START")=$HOROLOG
- +6 FOR XDRDA=0:0
- SET XDRDA=$ORDER(@XDRGLB)
- if XDRDA'>0
- QUIT
- Begin DoDot:1
- +7 IF $DATA(@XDRGLB@(-9))
- QUIT
- +8 SET @XDRTMP@(" CURR")=XDRDA
- SET ^(" TIME")=$HOROLOG
- +9 SET NTOT=NTOT+1
- +10 SET @XDRTMP@(" TOTAL")=NTOT
- +11 IF '$DATA(@XDRGLB@(0))
- Begin DoDot:2
- +12 SET XXX="NO ZERO NODE"
- +13 SET ^(XXX)=$GET(@XDRTMP@(XXX))+1
- +14 SET @XDRTMP@(XXX,XDRDA)=""
- End DoDot:2
- QUIT
- +15 IF XDRDR'=""
- Begin DoDot:2
- +16 SET DR=XDRDR
- +17 SET DA=XDRDA
- SET DIC=XDRFL
- SET DIQ(0)="I"
- SET DIQ="XDRX"
- KILL XDRX
- +18 DO EN^DIQ1
- +19 SET N=0
- +20 FOR I=0:0
- SET I=$ORDER(XDRX(XDRFL,XDRDA,I))
- if I'>0
- QUIT
- Begin DoDot:3
- +21 IF XDRX(XDRFL,XDRDA,I,"I")=""
- Begin DoDot:4
- +22 SET N=N+1
- +23 SET XXX="MISSING #"_I
- +24 SET @XDRTMP@(XXX)=$GET(@XDRTMP@(XXX))+1
- +25 SET @XDRTMP@(XXX,XDRDA)=""
- End DoDot:4
- End DoDot:3
- +26 SET XXX=$GET(XDRX(XDRFL,XDRDA,$SELECT(XDRFL=2:.09,XDRFL=200:9,1:0),"I"))
- +27 IF XXX'=""
- Begin DoDot:3
- +28 IF XXX'?9N.E
- Begin DoDot:4
- +29 SET XXX="BAD SSN"
- +30 SET @XDRTMP@(XXX)=$GET(@XDRTMP@(XXX))+1
- +31 SET @XDRTMP@(XXX,XDRDA)=""
- +32 SET N=N+1
- End DoDot:4
- End DoDot:3
- +33 IF N>0
- Begin DoDot:3
- +34 SET XXX="MISSING "_N_" VAL"_$SELECT(N>1:"S",1:"")
- +35 SET @XDRTMP@(XXX)=$GET(@XDRTMP@(XXX))+1
- +36 SET @XDRTMP@(XXX,XDRDA)=""
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +37 SET @XDRTMP@(" DONE")=$HOROLOG
- +38 KILL @XDRTMP@(" TIME")
- +39 QUIT
- VIEW(XDRFL) ;
- +1 NEW XDRTMP,X,Y,XTIME
- +2 SET XDRTMP="^XTMP(""XDRDPREL"",XDRFL)"
- +3 IF '$DATA(@XDRTMP)
- QUIT
- +4 LOCK +@XDRTMP
- +5 SET X=""
- +6 FOR
- SET X=$ORDER(@XDRTMP@(X))
- if X=""
- QUIT
- SET X(X)=@XDRTMP@(X)
- +7 LOCK -@XDRTMP
- +8 SET XRUN=$$HDIFF^XLFDT($SELECT($DATA(X(" DONE")):X(" DONE"),1:X(" TIME")),X(" START"),2)
- +9 SET XTIME=(XRUN\3600)_":"_$SELECT((XRUN#3600\60)<10:"0",1:"")_(XRUN#3600\60)_":"_$SELECT((XRUN#60)<10:"0",1:"")_(XRUN#60)
- +10 WRITE @IOF
- +11 WRITE !!!,"RUN TIME: ",XTIME," CURRENT IEN: ",X(" CURR")," FILE ENTRIES: ",X(" TOTAL")
- +12 WRITE !
- +13 SET X=""
- FOR
- SET X=$ORDER(X(X))
- if X=""
- QUIT
- IF X["#"
- Begin DoDot:1
- +14 SET Y=+$PIECE(X,"#",2)
- +15 WRITE !,$JUSTIFY(X(X),10)," ",XDRFNAM," entries are missing field # ",Y," ",$PIECE(^DD(XDRFL,Y,0),U)
- End DoDot:1
- +16 IF $DATA(X("NO ZERO NODE"))
- WRITE !,$JUSTIFY(X("NO ZERO NODE"),10)," ",XDRFNAM," entries have NO zero node!"
- +17 IF $DATA(X("BAD SSN"))
- WRITE !,$JUSTIFY(X("BAD SSN"),10)," ",XDRFNAM," entries have bad SSN values (non-numeric, etc.)"
- +18 SET X=""
- WRITE !
- +19 FOR
- SET X=$ORDER(X(X))
- if X=""
- QUIT
- IF X["VAL"
- Begin DoDot:1
- +20 SET Y=+$PIECE(X," ",2)
- +21 WRITE !,$JUSTIFY(X(X),10)," ",XDRFNAM," entries are missing ",Y," of the fields above"
- End DoDot:1
- +22 WRITE !
- KILL DIR
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- +23 QUIT
- +24 ;
- EXIT QUIT