DGENCLN1 ;ALB/CJM - National Enrollment Seeding, Patient File Cleanup; 2/22/1999
;;5.3;Registration;**222**;08/13/93
;
CLEANUP ;This entry point will do the cleanup.
;
N DGENSKIP
S DGENSKIP=0
W !,"*** This is a one-time cleanup for the National Enrollment Seeding ***"
W !,"Patient records whose seeding update may not have completed will be"
W !,"reported, and a query for each patient will be sent to HEC in order"
W !,"to complete the cleanup. Also, records in the Patient file with no"
W !,"zero node that were created by the seeding will be deleted."
I $$DEVICE() D ENTER
Q
;
REPORT ;This entry point was provided for testing, so that before
;patient records are deleted the site can have a list of
;the DFN's that would be deleted.
;
;Use this entry point to report on what the cleanup would do.
;No changes will be made to the database.
;
N DGENSKIP
S DGENSKIP=1
W !,"*** This is a one-time report for the National Enrollment Seeding ***"
W !,"Patient records whose seeding update may not have completed will be"
W !,"reported. Also, records in the Patient file with no zero node that"
W !,"were created by the seeding will be listed by DFN"
I $$DEVICE() D ENTER
Q
;
ENTER ;
;Description: This routine looks at patients included in the
;seeding. It reports each patient where the update may not have
;completed for the fields RECEIVING VA DISABILITY, or ELIGIBLE
;FOR MEDICAID?, or POW STATUS INDICATED? It re-queries HEC for
;those patients.
;
N DFN,AUDIT,ANODE,NAME,SSN,COUNT,XREFDFN,NAMESSN,LINE,SEEDDATE,DGENON
K ^TMP($J)
S (AUDIT,XREFDFN,COUNT)=0
;
I '$G(DGENSKIP) D
.S DGENON=$$ON^DGENQRY
.I 'DGENON D TURNON^DGENQRY
F S XREFDFN=$O(^DGENA(27.14,"C",XREFDFN)) Q:'XREFDFN S AUDIT=$O(^DGENA(27.14,"C",XREFDFN,9999999999),-1) Q:'AUDIT D
.N COND
.S ANODE=$G(^DGENA(27.14,AUDIT,0))
.S SEEDDATE=($P(ANODE,"^",2)\1)
.S DFN=$P(ANODE,"^",3)
.Q:'DFN
.Q:(XREFDFN'=DFN)
.I $$PARSE(AUDIT,DFN,SEEDDATE,.COND) D
..S COUNT=COUNT+1
..I '$G(DGENSKIP) I $$SEND^DGENQRY1(DFN)
..S NAME=$$NAME^DGENPTA(DFN) Q:(NAME="")
..S SSN=$$SSN^DGENPTA(DFN) Q:(SSN="")
..S NAMESSN=$$LJ(NAME,32)_" "_SSN
..S ^TMP($J,NAMESSN,DFN)=SEEDDATE
..S LINE=0 F S LINE=$O(COND(LINE)) Q:'LINE S ^TMP($J,NAMESSN,DFN,LINE)=COND(LINE)
D PRINT(COUNT)
K ^TMP($J)
I '$G(DGENSKIP) D
.I 'DGENON D TURNOFF^DGENQRY
;
;don't need the printer anymore, unless the bad patient records are
;just being reported rather than deleted
D:('DGENSKIP) ^%ZISC
;
;process the patient records with no 0 node
D DELETE(DGENSKIP)
D:(DGENSKIP) ^%ZISC
I $D(ZTQUEUED) S ZTREQ="@"
Q
PRINT(COUNT) ;
N NAME,DFN,LINE,NODE,PAGE,QUIT,CRT
S QUIT=0
S CRT=$S($E(IOST,1,2)="C-":1,1:0)
U IO
W @IOF
S PAGE=1
D HEADER(1)
S NAME=""
F S NAME=$O(^TMP($J,NAME)) Q:(NAME="") Q:QUIT D
.S DFN=0
.F S DFN=$O(^TMP($J,NAME,DFN)) Q:'DFN D
..S LINE=$G(^TMP($J,NAME,DFN))
..S QUIT=$$PLINE(.PAGE,NAME_" "_$$DATE(LINE)) Q:QUIT
..S LINE=0
..F S LINE=$O(^TMP($J,NAME,DFN,LINE)) Q:'LINE S QUIT=$$PLINE(.PAGE," "_$G(^TMP($J,NAME,DFN,LINE))) Q:QUIT
..S QUIT=$$PLINE(.PAGE," ") Q:QUIT
W !!," *** Total #Patients Found: "_COUNT_" ***"
Q
;
PARSE(AUDIT,DFN,SEEDDATE,COND) ;
;Description: looks for particular changes in the Enrollment Upload
;Audit file (#27.14) for the record=AUDIT. Returns 1 if found, 0 otherwise.
;
N NODE,FOUND,LINE,COUNT,NEWVALUE,PAT,DATABASE
S (LINE,FOUND,COUNT)=0
F S LINE=$O(^DGENA(27.14,AUDIT,1,LINE)) Q:'LINE D Q:'LINE
.S NODE=$G(^DGENA(27.14,AUDIT,1,LINE,0))
.;
.I NODE["POW:" D
..I '$D(PAT) D GETPAT(DFN,.PAT)
..S NEWVALUE=$$STRIP($E(NODE,41,100))
..S DATABASE=$$EXT^DGENELA3("POW",PAT("POW"))
..I NEWVALUE'=DATABASE S FOUND=1,COUNT=COUNT+1,COND(COUNT)=$$LJ("POW STATUS INDICATED?",30)_" seeding: "_$$LJ(NEWVALUE,8)_" database: "_DATABASE
.;
.I NODE["MEDICAID:" D
..I '$D(PAT) D GETPAT(DFN,.PAT)
..S NEWVALUE=$$STRIP($E(NODE,41,100))
..S DATABASE=$$EXT^DGENELA3("MEDICAID",PAT("MEDICAID"))
..I NEWVALUE'=DATABASE,(SEEDDATE>PAT("LAST ASKED")) S FOUND=1,COUNT=COUNT+1,COND(COUNT)=$$LJ("ELIGIBLE FOR MEDICAID? ",30)_" seeding: "_$$LJ(NEWVALUE,8)_" database: "_DATABASE
.;
.I NODE["VADISAB:" D
..I '$D(PAT) D GETPAT(DFN,.PAT)
..S DATABASE=$$EXT^DGENELA3("VADISAB",PAT("VADISAB"))
..S NEWVALUE=$$STRIP($E(NODE,41,100))
..I NEWVALUE'=DATABASE S FOUND=1,COUNT=COUNT+1,COND(COUNT)=$$LJ("RECEIVING VA DISABILITY?",30)_" seeding: "_$$LJ(NEWVALUE,8)_" database: "_DATABASE
Q FOUND
;
GETPAT(DFN,PAT) ;
;Gets several fields from the patient file and returns them in the PAT
;array
;
N NODE
S PAT("VADISAB")=$P($G(^DPT(DFN,.3)),"^",11)
S PAT("POW")=$P($G(^DPT(DFN,.52)),"^",5)
S NODE=$G(^DPT(DFN,.38))
S PAT("MEDICAID")=$P(NODE,"^")
S PAT("LAST ASKED")=$P(NODE,"^",2)
Q
DEVICE() ;
;Description: allows the user to select a device.
;
;Output:
; Function Value - Returns 0 if the user decides not to print or to
; queue the report, 1 otherwise.
;
N OK
S OK=1
S %ZIS="MQ"
D ^%ZIS
S:POP OK=0
D:OK&$D(IO("Q"))
.S ZTRTN="ENTER^DGENCLN1",ZTDESC=$S(DGENSKIP:"Report",1:"Cleanup")_" of Incomplete Patient Updates, Enrollment Seeding"
.S ZTSAVE("DGENSKIP")=""
.D ^%ZTLOAD
.W !,$S($D(ZTSK):"REQUEST QUEUED TASK="_ZTSK,1:"REQUEST CANCELLED")
.D HOME^%ZIS
.S OK=0
Q OK
;
PLINE(PAGE,LINE) ;
;Description: prints a line. First prints header if at end of page.
;Returns 1 on success, 0 if the user enters '^'
;
N QUIT S QUIT=0
I CRT,($Y>(IOSL-5)) D
.S QUIT=$$PAUSE
.Q:QUIT
.W @IOF
.S PAGE=PAGE+1
.D HEADER(PAGE)
.W LINE
;
E I ('CRT),($Y>(IOSL-5)) D
.W @IOF
.S PAGE=PAGE+1
.D HEADER(PAGE)
.W LINE
;
E W !,LINE
Q QUIT
;
W !,?((IOM-77)/2),"Incomplete Patient Updates from National Enrollment Seeding",?(IOM-10),"PAGE: ",PAGE
W !,?((IOM-24)\2),$$FMTE^XLFDT(DT,"D")
W !!," Patient SSN Date Of Seeding"
W !,"____________________________________________________________________________",!
Q
;
PAUSE() ;
;Description: Screen pause. Sets QUIT=1 if user decides to quit.
;
N DIR,X,Y,QUIT
S QUIT=0
F Q:$Y>(IOSL-4) W !
S DIR(0)="E" D ^DIR
I '(+Y) S QUIT=1
Q QUIT
;
DATE(FMDATE) ;
N DATE S DATE=""
S FMDATE=FMDATE\1
I FMDATE S DATE=$$FMTE^XLFDT(FMDATE,"1")
Q DATE
;
;
LJ(STR,LEN) ;
Q $$LJ^XLFSTR($E(STR,1,LEN),LEN)
;
STRIP(STR) ;
N I
F I=1:1:$L(STR) I $E(STR,I,I)'=" " Q
S STR=$E(STR,I,$L(STR))
S STR=$REVERSE(STR)
F I=1:1:$L(STR) I $E(STR,I,I)'=" " Q
S STR=$E(STR,I,$L(STR))
S STR=$REVERSE(STR)
Q STR
;
DELETE(DGENSKIP) ;
;This will delete bogus patient records created during the seeding
;A patient record will be deleted if the only nodes are the .3,
;.38, or .52
;
;Input: DGENSKIP - if =1, the the records will not be deleted, but just reported
;
N DFN,SUB,GOOD,COUNT
W:DGENSKIP !!!,"Begining to search for bad patient records...."
S (COUNT,DFN)=0
F S DFN=$O(^DPT(DFN)) Q:'DFN D
.S SUB=""
.S GOOD=0
.F S SUB=$O(^DPT(DFN,SUB)) Q:(SUB="") D
..I (SUB'=.3),(SUB'=.38),(SUB'=.52) S GOOD=1 Q
.I 'GOOD D
..S COUNT=COUNT+1
..I DGENSKIP W !,"BAD PATIENT RECORD FOUND, DFN= ",DFN
..I 'DGENSKIP D
...N DIK,DA
...S DIK="^DPT(",DA=DFN D ^DIK
W:DGENSKIP !!,"*** COUNT OF BAD PATIENT RECORDS (MISSING THE 0 NODE)"_$S(DGENSKIP:"",1:" DELETED")_": ",COUNT," ***"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGENCLN1 7499 printed Sep 23, 2025@20:18:25 Page 2
DGENCLN1 ;ALB/CJM - National Enrollment Seeding, Patient File Cleanup; 2/22/1999
+1 ;;5.3;Registration;**222**;08/13/93
+2 ;
CLEANUP ;This entry point will do the cleanup.
+1 ;
+2 NEW DGENSKIP
+3 SET DGENSKIP=0
+4 WRITE !,"*** This is a one-time cleanup for the National Enrollment Seeding ***"
+5 WRITE !,"Patient records whose seeding update may not have completed will be"
+6 WRITE !,"reported, and a query for each patient will be sent to HEC in order"
+7 WRITE !,"to complete the cleanup. Also, records in the Patient file with no"
+8 WRITE !,"zero node that were created by the seeding will be deleted."
+9 IF $$DEVICE()
DO ENTER
+10 QUIT
+11 ;
REPORT ;This entry point was provided for testing, so that before
+1 ;patient records are deleted the site can have a list of
+2 ;the DFN's that would be deleted.
+3 ;
+4 ;Use this entry point to report on what the cleanup would do.
+5 ;No changes will be made to the database.
+6 ;
+7 NEW DGENSKIP
+8 SET DGENSKIP=1
+9 WRITE !,"*** This is a one-time report for the National Enrollment Seeding ***"
+10 WRITE !,"Patient records whose seeding update may not have completed will be"
+11 WRITE !,"reported. Also, records in the Patient file with no zero node that"
+12 WRITE !,"were created by the seeding will be listed by DFN"
+13 IF $$DEVICE()
DO ENTER
+14 QUIT
+15 ;
ENTER ;
+1 ;Description: This routine looks at patients included in the
+2 ;seeding. It reports each patient where the update may not have
+3 ;completed for the fields RECEIVING VA DISABILITY, or ELIGIBLE
+4 ;FOR MEDICAID?, or POW STATUS INDICATED? It re-queries HEC for
+5 ;those patients.
+6 ;
+7 NEW DFN,AUDIT,ANODE,NAME,SSN,COUNT,XREFDFN,NAMESSN,LINE,SEEDDATE,DGENON
+8 KILL ^TMP($JOB)
+9 SET (AUDIT,XREFDFN,COUNT)=0
+10 ;
+11 IF '$GET(DGENSKIP)
Begin DoDot:1
+12 SET DGENON=$$ON^DGENQRY
+13 IF 'DGENON
DO TURNON^DGENQRY
End DoDot:1
+14 FOR
SET XREFDFN=$ORDER(^DGENA(27.14,"C",XREFDFN))
if 'XREFDFN
QUIT
SET AUDIT=$ORDER(^DGENA(27.14,"C",XREFDFN,9999999999),-1)
if 'AUDIT
QUIT
Begin DoDot:1
+15 NEW COND
+16 SET ANODE=$GET(^DGENA(27.14,AUDIT,0))
+17 SET SEEDDATE=($PIECE(ANODE,"^",2)\1)
+18 SET DFN=$PIECE(ANODE,"^",3)
+19 if 'DFN
QUIT
+20 if (XREFDFN'=DFN)
QUIT
+21 IF $$PARSE(AUDIT,DFN,SEEDDATE,.COND)
Begin DoDot:2
+22 SET COUNT=COUNT+1
+23 IF '$GET(DGENSKIP)
IF $$SEND^DGENQRY1(DFN)
+24 SET NAME=$$NAME^DGENPTA(DFN)
if (NAME="")
QUIT
+25 SET SSN=$$SSN^DGENPTA(DFN)
if (SSN="")
QUIT
+26 SET NAMESSN=$$LJ(NAME,32)_" "_SSN
+27 SET ^TMP($JOB,NAMESSN,DFN)=SEEDDATE
+28 SET LINE=0
FOR
SET LINE=$ORDER(COND(LINE))
if 'LINE
QUIT
SET ^TMP($JOB,NAMESSN,DFN,LINE)=COND(LINE)
End DoDot:2
End DoDot:1
+29 DO PRINT(COUNT)
+30 KILL ^TMP($JOB)
+31 IF '$GET(DGENSKIP)
Begin DoDot:1
+32 IF 'DGENON
DO TURNOFF^DGENQRY
End DoDot:1
+33 ;
+34 ;don't need the printer anymore, unless the bad patient records are
+35 ;just being reported rather than deleted
+36 if ('DGENSKIP)
DO ^%ZISC
+37 ;
+38 ;process the patient records with no 0 node
+39 DO DELETE(DGENSKIP)
+40 if (DGENSKIP)
DO ^%ZISC
+41 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+42 QUIT
PRINT(COUNT) ;
+1 NEW NAME,DFN,LINE,NODE,PAGE,QUIT,CRT
+2 SET QUIT=0
+3 SET CRT=$SELECT($EXTRACT(IOST,1,2)="C-":1,1:0)
+4 USE IO
+5 WRITE @IOF
+6 SET PAGE=1
+7 DO HEADER(1)
+8 SET NAME=""
+9 FOR
SET NAME=$ORDER(^TMP($JOB,NAME))
if (NAME="")
QUIT
if QUIT
QUIT
Begin DoDot:1
+10 SET DFN=0
+11 FOR
SET DFN=$ORDER(^TMP($JOB,NAME,DFN))
if 'DFN
QUIT
Begin DoDot:2
+12 SET LINE=$GET(^TMP($JOB,NAME,DFN))
+13 SET QUIT=$$PLINE(.PAGE,NAME_" "_$$DATE(LINE))
if QUIT
QUIT
+14 SET LINE=0
+15 FOR
SET LINE=$ORDER(^TMP($JOB,NAME,DFN,LINE))
if 'LINE
QUIT
SET QUIT=$$PLINE(.PAGE," "_$GET(^TMP($JOB,NAME,DFN,LINE)))
if QUIT
QUIT
+16 SET QUIT=$$PLINE(.PAGE," ")
if QUIT
QUIT
End DoDot:2
End DoDot:1
+17 WRITE !!," *** Total #Patients Found: "_COUNT_" ***"
+18 QUIT
+19 ;
PARSE(AUDIT,DFN,SEEDDATE,COND) ;
+1 ;Description: looks for particular changes in the Enrollment Upload
+2 ;Audit file (#27.14) for the record=AUDIT. Returns 1 if found, 0 otherwise.
+3 ;
+4 NEW NODE,FOUND,LINE,COUNT,NEWVALUE,PAT,DATABASE
+5 SET (LINE,FOUND,COUNT)=0
+6 FOR
SET LINE=$ORDER(^DGENA(27.14,AUDIT,1,LINE))
if 'LINE
QUIT
Begin DoDot:1
+7 SET NODE=$GET(^DGENA(27.14,AUDIT,1,LINE,0))
+8 ;
+9 IF NODE["POW:"
Begin DoDot:2
+10 IF '$DATA(PAT)
DO GETPAT(DFN,.PAT)
+11 SET NEWVALUE=$$STRIP($EXTRACT(NODE,41,100))
+12 SET DATABASE=$$EXT^DGENELA3("POW",PAT("POW"))
+13 IF NEWVALUE'=DATABASE
SET FOUND=1
SET COUNT=COUNT+1
SET COND(COUNT)=$$LJ("POW STATUS INDICATED?",30)_" seeding: "_$$LJ(NEWVALUE,8)_" database: "_DATABASE
End DoDot:2
+14 ;
+15 IF NODE["MEDICAID:"
Begin DoDot:2
+16 IF '$DATA(PAT)
DO GETPAT(DFN,.PAT)
+17 SET NEWVALUE=$$STRIP($EXTRACT(NODE,41,100))
+18 SET DATABASE=$$EXT^DGENELA3("MEDICAID",PAT("MEDICAID"))
+19 IF NEWVALUE'=DATABASE
IF (SEEDDATE>PAT("LAST ASKED"))
SET FOUND=1
SET COUNT=COUNT+1
SET COND(COUNT)=$$LJ("ELIGIBLE FOR MEDICAID? ",30)_" seeding: "_$$LJ(NEWVALUE,8)_" database: "_DATABASE
End DoDot:2
+20 ;
+21 IF NODE["VADISAB:"
Begin DoDot:2
+22 IF '$DATA(PAT)
DO GETPAT(DFN,.PAT)
+23 SET DATABASE=$$EXT^DGENELA3("VADISAB",PAT("VADISAB"))
+24 SET NEWVALUE=$$STRIP($EXTRACT(NODE,41,100))
+25 IF NEWVALUE'=DATABASE
SET FOUND=1
SET COUNT=COUNT+1
SET COND(COUNT)=$$LJ("RECEIVING VA DISABILITY?",30)_" seeding: "_$$LJ(NEWVALUE,8)_" database: "_DATABASE
End DoDot:2
End DoDot:1
if 'LINE
QUIT
+26 QUIT FOUND
+27 ;
GETPAT(DFN,PAT) ;
+1 ;Gets several fields from the patient file and returns them in the PAT
+2 ;array
+3 ;
+4 NEW NODE
+5 SET PAT("VADISAB")=$PIECE($GET(^DPT(DFN,.3)),"^",11)
+6 SET PAT("POW")=$PIECE($GET(^DPT(DFN,.52)),"^",5)
+7 SET NODE=$GET(^DPT(DFN,.38))
+8 SET PAT("MEDICAID")=$PIECE(NODE,"^")
+9 SET PAT("LAST ASKED")=$PIECE(NODE,"^",2)
+10 QUIT
DEVICE() ;
+1 ;Description: allows the user to select a device.
+2 ;
+3 ;Output:
+4 ; Function Value - Returns 0 if the user decides not to print or to
+5 ; queue the report, 1 otherwise.
+6 ;
+7 NEW OK
+8 SET OK=1
+9 SET %ZIS="MQ"
+10 DO ^%ZIS
+11 if POP
SET OK=0
+12 if OK&$DATA(IO("Q"))
Begin DoDot:1
+13 SET ZTRTN="ENTER^DGENCLN1"
SET ZTDESC=$SELECT(DGENSKIP:"Report",1:"Cleanup")_" of Incomplete Patient Updates, Enrollment Seeding"
+14 SET ZTSAVE("DGENSKIP")=""
+15 DO ^%ZTLOAD
+16 WRITE !,$SELECT($DATA(ZTSK):"REQUEST QUEUED TASK="_ZTSK,1:"REQUEST CANCELLED")
+17 DO HOME^%ZIS
+18 SET OK=0
End DoDot:1
+19 QUIT OK
+20 ;
PLINE(PAGE,LINE) ;
+1 ;Description: prints a line. First prints header if at end of page.
+2 ;Returns 1 on success, 0 if the user enters '^'
+3 ;
+4 NEW QUIT
SET QUIT=0
+5 IF CRT
IF ($Y>(IOSL-5))
Begin DoDot:1
+6 SET QUIT=$$PAUSE
+7 if QUIT
QUIT
+8 WRITE @IOF
+9 SET PAGE=PAGE+1
+10 DO HEADER(PAGE)
+11 WRITE LINE
End DoDot:1
+12 ;
+13 IF '$TEST
IF ('CRT)
IF ($Y>(IOSL-5))
Begin DoDot:1
+14 WRITE @IOF
+15 SET PAGE=PAGE+1
+16 DO HEADER(PAGE)
+17 WRITE LINE
End DoDot:1
+18 ;
+19 IF '$TEST
WRITE !,LINE
+20 QUIT QUIT
+21 ;
+1 WRITE !,?((IOM-77)/2),"Incomplete Patient Updates from National Enrollment Seeding",?(IOM-10),"PAGE: ",PAGE
+2 WRITE !,?((IOM-24)\2),$$FMTE^XLFDT(DT,"D")
+3 WRITE !!," Patient SSN Date Of Seeding"
+4 WRITE !,"____________________________________________________________________________",!
+5 QUIT
+6 ;
PAUSE() ;
+1 ;Description: Screen pause. Sets QUIT=1 if user decides to quit.
+2 ;
+3 NEW DIR,X,Y,QUIT
+4 SET QUIT=0
+5 FOR
if $Y>(IOSL-4)
QUIT
WRITE !
+6 SET DIR(0)="E"
DO ^DIR
+7 IF '(+Y)
SET QUIT=1
+8 QUIT QUIT
+9 ;
DATE(FMDATE) ;
+1 NEW DATE
SET DATE=""
+2 SET FMDATE=FMDATE\1
+3 IF FMDATE
SET DATE=$$FMTE^XLFDT(FMDATE,"1")
+4 QUIT DATE
+5 ;
+6 ;
LJ(STR,LEN) ;
+1 QUIT $$LJ^XLFSTR($EXTRACT(STR,1,LEN),LEN)
+2 ;
STRIP(STR) ;
+1 NEW I
+2 FOR I=1:1:$LENGTH(STR)
IF $EXTRACT(STR,I,I)'=" "
QUIT
+3 SET STR=$EXTRACT(STR,I,$LENGTH(STR))
+4 SET STR=$REVERSE(STR)
+5 FOR I=1:1:$LENGTH(STR)
IF $EXTRACT(STR,I,I)'=" "
QUIT
+6 SET STR=$EXTRACT(STR,I,$LENGTH(STR))
+7 SET STR=$REVERSE(STR)
+8 QUIT STR
+9 ;
DELETE(DGENSKIP) ;
+1 ;This will delete bogus patient records created during the seeding
+2 ;A patient record will be deleted if the only nodes are the .3,
+3 ;.38, or .52
+4 ;
+5 ;Input: DGENSKIP - if =1, the the records will not be deleted, but just reported
+6 ;
+7 NEW DFN,SUB,GOOD,COUNT
+8 if DGENSKIP
WRITE !!!,"Begining to search for bad patient records...."
+9 SET (COUNT,DFN)=0
+10 FOR
SET DFN=$ORDER(^DPT(DFN))
if 'DFN
QUIT
Begin DoDot:1
+11 SET SUB=""
+12 SET GOOD=0
+13 FOR
SET SUB=$ORDER(^DPT(DFN,SUB))
if (SUB="")
QUIT
Begin DoDot:2
+14 IF (SUB'=.3)
IF (SUB'=.38)
IF (SUB'=.52)
SET GOOD=1
QUIT
End DoDot:2
+15 IF 'GOOD
Begin DoDot:2
+16 SET COUNT=COUNT+1
+17 IF DGENSKIP
WRITE !,"BAD PATIENT RECORD FOUND, DFN= ",DFN
+18 IF 'DGENSKIP
Begin DoDot:3
+19 NEW DIK,DA
+20 SET DIK="^DPT("
SET DA=DFN
DO ^DIK
End DoDot:3
End DoDot:2
End DoDot:1
+21 if DGENSKIP
WRITE !!,"*** COUNT OF BAD PATIENT RECORDS (MISSING THE 0 NODE)"_$SELECT(DGENSKIP:"",1:" DELETED")_": ",COUNT," ***"
+22 QUIT
