- 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 Jan 18, 2025@03:43:15 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