Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DGENCLN1

DGENCLN1.m

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