- AZHZCL ;DSD/PDW - CLEAN PATIENT DATA BASE ; AUGUST 14, 1992
- ;;1.0;AZHZ;;AUG 14, 1992
- ;;
- S ;
- S:'$D(DUOUT) DUOUT=0 S:'$D(DFOUT) DFOUT=0
- Q:(DUOUT!DFOUT) ;----
- Q:'$D(^AUTTSITE(1,0)) S AZHZSITE=+^(0),U="^"
- I $P(^AUTTLOC(+^AUTTSITE(1,0),0),U,10)]"" S AZHZ("LOC")=$E($P(^(0),U,10),1,4),AZHZ("L")=0
- I '$D(AZHZ("LOC")) W !,"Site and Area not specified for facility <Fatal Error>",! S (DUOUT,DFOUT)=1 Q
- I $D(^AZHZTEMP("A",1)) W !,*7,"< SCAN has already been Completed >",! G EXIT ;-----
- S AZHZHIT=0,AZHZHDR=" IHS/VA DATA BASE PATIENT CLEAN",AZHZRTN="DQSCAN^AZHZCL"
- D INIT Q:(DFOUT!DUOUT)
- DQSCAN ;ENTRY POINT FOR TASKING
- S ^AZHZTEMP="SCAN"
- W "Each dot =100 patients:",!,"Running for ",AZHZSITE,":",$P(^AUTTLOC(AZHZSITE,0),"^",2)," Area and Service : ",AZHZ("LOC"),!
- S AZHZ("B")="" S:$D(^AZHZTEMP("LDFN")) AZHZ("B")=^("LDFN"),AZHZ("B")=$E(AZHZ("B"),1,($L(AZHZ("B"))-1)) ; pick up at last completed patient
- IEN F AZHZZ("I")=1:1 S AZHZ("B")=$O(^DPT("B",AZHZ("B"))) Q:(DFOUT!DUOUT) Q:AZHZ("B")="" S DFN=0 F S DFN=$O(^DPT("B",AZHZ("B"),DFN)) Q:(DFOUT!DUOUT) Q:'DFN D SCDFN S ^AZHZTEMP("LDFN")=AZHZ("B") W:'(AZHZZ("I")#100) "."
- ;
- BINDEX S DFN=0 K ^AZHZTEMP("B") F AZHZCC=0:1 S DFN=$O(^AZHZTEMP(DFN)) Q:'DFN S ^AZHZTEMP("B",^(DFN),DFN)=""
- S ^AZHZTEMP(0)=AZHZCC W !!,AZHZZ("I")," Patient Names Scanned with ",AZHZCC," set for error corrections"
- I '(DFOUT!DUOUT) S ^AZHZTEMP="",^AZHZTEMP("A",1,"SCAN COMPLETE")="" K ^AZHZTEMP("LDFN") D SAV^AZHZCLN
- G EXIT ;----
- ;
- ;-------------------------------
- SCDFN ;ENTRY POINT scan DFN for data errors, VA and IHS checks
- I '$D(^DPT(DFN,0)) K ^DPT("B",AZHZ("B"),DFN) Q
- Q:($P(^DPT(DFN,0),U,19)) ;quit if Merge Patient has TO DFN in 19th peice
- D ^AZHZCLV ;perform VA DPT edits
- I $D(^AUPNPAT(DFN,0)) D ^AZHZCLI ;perform IHS patient edits
- S:$D(^AZHZTEMP(DFN)) ^AZHZTEMP(DFN)=$P(^DPT(DFN,0),U)
- ESCDFN Q ;-----
- ;-------------------------------
- SET ; ENTRY POINT: perform sets
- S:'$D(DUOUT) DUOUT=0 S:'$D(DFOUT) DFOUT=0
- Q:(DFOUT!DUOUT) ;----
- Q:'$D(^AUTTSITE(1,0)) S AZHZSITE=+^(0),U="^"
- I '$D(^AZHZTEMP) W *7,!,"<NO Compiled Edits Global Present>",! Q
- I ^AZHZTEMP]"",^AZHZTEMP'="SET" W !,"SORRY ... ",^AZHZTEMP," NEEDS TO BE COMPLETED FIRST",! G EXIT ;----
- I $D(^AZHZTEMP("A",3)) W !,"< EDITS have already been Completed >",!,*7 G EXIT ;-----
- W !,"There are only dots printed for this option",!
- S AZHZHIT=1,AZHZSET="N",AZHZHDR="IHS/VA PATIENT DATA BASE EDITS",AZHZRTN="DQSET^AZHZCL"
- D INIT Q:(DFOUT!DUOUT)
- DQSET ;ENTRY POINT FOR TASKING
- S ^AZHZTEMP="SET",DFN=0 K ^AZHZTEMP("P")
- W !,"EACH DOT =100 PATIENTS SET. THERE ARE ",^AZHZTEMP(0)," PATIENTS TO PROCESS",!,"STARTING AT " D ^%T W ! D DOIT
- I '(DFOUT!DUOUT) S ^AZHZTEMP="",^AZHZTEMP("A",3,"EDITS COMPLETED")="" K ^AZHZTEMP("LDFN")
- ;K ^AZHZSAV S %X="AZHZTEMP(",%Y="^AZHZSAV(" D %XY^%RCR
- G EXIT ;----
- ;-------------------------------
- PULL ;ENTRY POINT: set data back to previous state
- I '$D(^AZHZTEMP) W *7,!,"<NO Compiled Edits Global Present>",! Q
- I ^AZHZTEMP]"",^AZHZTEMP'="PULL" W !,"SORRY ... ",^AZHZTEMP," NEEDS TO BE COMPLETED FIRST",! G EXIT ;----
- Q W !,"This will put data fields back to their incorrect forms.",!,"Are you sure you want to proceed ? " S %=2 D YN^DICN
- I (%=2)!(%=-1) S DUOUT=1 G EXIT ;-----
- G:%<1 Q
- S AZHZHIT=1,AZHZSET="O",AZHZHDR="IHS/VA PATIENT DATA BASE RESTORE",AZHZRTN="DQPULL^AZHZCL" D INIT Q:(DFOUT!DUOUT)
- DQPULL ;ENTRY POINT FOR TASKING
- S ^AZHZTEMP="PULL",DFN=0
- W !,"EACH DOT =100 PATIENTS SET. THERE ARE ",^AZHZTEMP(0)," PATIENTS TO PROCESS",!,"STARTING AT " D ^%T W ! D DOIT
- S ^AZHZTEMP="" K ^AZHZTEMP G EXIT ;----kills old temp global prior to restore
- ;-------------------------------
- PRT ;ENTRY POINT: print report of edits to be performed
- S:'$D(DUOUT) DUOUT=0 S:'$D(DFOUT) DFOUT=0
- Q:(DUOUT!DFOUT) ;-----
- I '$D(^AZHZTEMP) W *7,!,"<NO Compiled Edits Global Present>",! Q
- I ^AZHZTEMP'="" W *7,!,"< Sorry ",^AZHZTEMP," needs to be completed first >",!,*7 G EXIT ;----
- I '$D(^AZHZTEMP("A",1)) W !,*7,"< SCAN must be completed First > ",! G EXIT ;-----
- S AZHZHIT=0,AZHZSET="O",AZHZHDR="IHS/VA PATIENT DATA BASE EDIT REPORT",AZHZRTN="DQPRT^AZHZCL"
- D INIT Q:(DFOUT!DUOUT)
- DQPRT ;ENTRY POINT FOR TASKING
- S DFN=0
- W !,"THERE ARE ",^AZHZTEMP(0)," PATIENTS TO PRINT",!,"STARTING AT " D ^%T W !
- W !," Patient Name : DFN",!," Old Data to be Corrected : New Data Corrections ",!!
- D DOIT S ^AZHZTEMP("A",2,"PRINTS PERFORMED")=""
- EPRT G EXIT ;----
- ;-------------------------------
- KILL ;ENTRY POINT kill ^AZHZTEMP
- I '$D(^AZHZTEMP) W *7,!,"<NO Compiled Edits Global Present>",! Q
- I '$D(^AZHZTEMP("A",4)) W !,*7,"<AGPATCH HAS NOT BEEN SET YET>",!,*7 Q
- K ^AZHZTEMP ;kill temp global
- Q ;----
- ;-------------------------------
- AZHZPG ;EP
- D AZHZPG^AZHZCL1 Q
- ;-------------------------------
- DOIT D ^AZHZCL1 Q
- ;-------------------------------
- INIT ;EP
- D INIT^AZHZCL1 Q
- ;-------------------------------
- EXIT ;EP
- D EXIT^AZHZCL1 Q
- ;-------------------------------
- AZHZCL ;DSD/PDW - CLEAN PATIENT DATA BASE ; AUGUST 14, 1992
- +1 ;;1.0;AZHZ;;AUG 14, 1992
- +2 ;;
- S ;
- +1 IF '$DATA(DUOUT)
- SET DUOUT=0
- IF '$DATA(DFOUT)
- SET DFOUT=0
- +2 ;----
- IF (DUOUT!DFOUT)
- QUIT
- +3 IF '$DATA(^AUTTSITE(1,0))
- QUIT
- SET AZHZSITE=+^(0)
- SET U="^"
- +4 IF $PIECE(^AUTTLOC(+^AUTTSITE(1,0),0),U,10)]""
- SET AZHZ("LOC")=$EXTRACT($PIECE(^(0),U,10),1,4)
- SET AZHZ("L")=0
- +5 IF '$DATA(AZHZ("LOC"))
- WRITE !,"Site and Area not specified for facility <Fatal Error>",!
- SET (DUOUT,DFOUT)=1
- QUIT
- +6 ;-----
- IF $DATA(^AZHZTEMP("A",1))
- WRITE !,*7,"< SCAN has already been Completed >",!
- GOTO EXIT
- +7 SET AZHZHIT=0
- SET AZHZHDR=" IHS/VA DATA BASE PATIENT CLEAN"
- SET AZHZRTN="DQSCAN^AZHZCL"
- +8 DO INIT
- IF (DFOUT!DUOUT)
- QUIT
- DQSCAN ;ENTRY POINT FOR TASKING
- +1 SET ^AZHZTEMP="SCAN"
- +2 WRITE "Each dot =100 patients:",!,"Running for ",AZHZSITE,":",$PIECE(^AUTTLOC(AZHZSITE,0),"^",2)," Area and Service : ",AZHZ("LOC"),!
- +3 ; pick up at last completed patient
- SET AZHZ("B")=""
- IF $DATA(^AZHZTEMP("LDFN"))
- SET AZHZ("B")=^("LDFN")
- SET AZHZ("B")=$EXTRACT(AZHZ("B"),1,($LENGTH(AZHZ("B"))-1))
- IEN FOR AZHZZ("I")=1:1
- SET AZHZ("B")=$ORDER(^DPT("B",AZHZ("B")))
- IF (DFOUT!DUOUT)
- QUIT
- IF AZHZ("B")=""
- QUIT
- SET DFN=0
- FOR
- SET DFN=$ORDER(^DPT("B",AZHZ("B"),DFN))
- IF (DFOUT!DUOUT)
- QUIT
- IF 'DFN
- QUIT
- DO SCDFN
- SET ^AZHZTEMP("LDFN")=AZHZ("B")
- IF '(AZHZZ("I")#100)
- WRITE "."
- +1 ;
- BINDEX SET DFN=0
- KILL ^AZHZTEMP("B")
- FOR AZHZCC=0:1
- SET DFN=$ORDER(^AZHZTEMP(DFN))
- IF 'DFN
- QUIT
- SET ^AZHZTEMP("B",^(DFN),DFN)=""
- +1 SET ^AZHZTEMP(0)=AZHZCC
- WRITE !!,AZHZZ("I")," Patient Names Scanned with ",AZHZCC," set for error corrections"
- +2 IF '(DFOUT!DUOUT)
- SET ^AZHZTEMP=""
- SET ^AZHZTEMP("A",1,"SCAN COMPLETE")=""
- KILL ^AZHZTEMP("LDFN")
- DO SAV^AZHZCLN
- +3 ;----
- GOTO EXIT
- +4 ;
- +5 ;-------------------------------
- SCDFN ;ENTRY POINT scan DFN for data errors, VA and IHS checks
- +1 IF '$DATA(^DPT(DFN,0))
- KILL ^DPT("B",AZHZ("B"),DFN)
- QUIT
- +2 ;quit if Merge Patient has TO DFN in 19th peice
- IF ($PIECE(^DPT(DFN,0),U,19))
- QUIT
- +3 ;perform VA DPT edits
- DO ^AZHZCLV
- +4 ;perform IHS patient edits
- IF $DATA(^AUPNPAT(DFN,0))
- DO ^AZHZCLI
- +5 IF $DATA(^AZHZTEMP(DFN))
- SET ^AZHZTEMP(DFN)=$PIECE(^DPT(DFN,0),U)
- ESCDFN ;-----
- QUIT
- +1 ;-------------------------------
- SET ; ENTRY POINT: perform sets
- +1 IF '$DATA(DUOUT)
- SET DUOUT=0
- IF '$DATA(DFOUT)
- SET DFOUT=0
- +2 ;----
- IF (DFOUT!DUOUT)
- QUIT
- +3 IF '$DATA(^AUTTSITE(1,0))
- QUIT
- SET AZHZSITE=+^(0)
- SET U="^"
- +4 IF '$DATA(^AZHZTEMP)
- WRITE *7,!,"<NO Compiled Edits Global Present>",!
- QUIT
- +5 ;----
- IF ^AZHZTEMP]""
- IF ^AZHZTEMP'="SET"
- WRITE !,"SORRY ... ",^AZHZTEMP," NEEDS TO BE COMPLETED FIRST",!
- GOTO EXIT
- +6 ;-----
- IF $DATA(^AZHZTEMP("A",3))
- WRITE !,"< EDITS have already been Completed >",!,*7
- GOTO EXIT
- +7 WRITE !,"There are only dots printed for this option",!
- +8 SET AZHZHIT=1
- SET AZHZSET="N"
- SET AZHZHDR="IHS/VA PATIENT DATA BASE EDITS"
- SET AZHZRTN="DQSET^AZHZCL"
- +9 DO INIT
- IF (DFOUT!DUOUT)
- QUIT
- DQSET ;ENTRY POINT FOR TASKING
- +1 SET ^AZHZTEMP="SET"
- SET DFN=0
- KILL ^AZHZTEMP("P")
- +2 WRITE !,"EACH DOT =100 PATIENTS SET. THERE ARE ",^AZHZTEMP(0)," PATIENTS TO PROCESS",!,"STARTING AT "
- DO ^%T
- WRITE !
- DO DOIT
- +3 IF '(DFOUT!DUOUT)
- SET ^AZHZTEMP=""
- SET ^AZHZTEMP("A",3,"EDITS COMPLETED")=""
- KILL ^AZHZTEMP("LDFN")
- +4 ;K ^AZHZSAV S %X="AZHZTEMP(",%Y="^AZHZSAV(" D %XY^%RCR
- +5 ;----
- GOTO EXIT
- +6 ;-------------------------------
- PULL ;ENTRY POINT: set data back to previous state
- +1 IF '$DATA(^AZHZTEMP)
- WRITE *7,!,"<NO Compiled Edits Global Present>",!
- QUIT
- +2 ;----
- IF ^AZHZTEMP]""
- IF ^AZHZTEMP'="PULL"
- WRITE !,"SORRY ... ",^AZHZTEMP," NEEDS TO BE COMPLETED FIRST",!
- GOTO EXIT
- Q WRITE !,"This will put data fields back to their incorrect forms.",!,"Are you sure you want to proceed ? "
- SET %=2
- DO YN^DICN
- +1 ;-----
- IF (%=2)!(%=-1)
- SET DUOUT=1
- GOTO EXIT
- +2 IF %<1
- GOTO Q
- +3 SET AZHZHIT=1
- SET AZHZSET="O"
- SET AZHZHDR="IHS/VA PATIENT DATA BASE RESTORE"
- SET AZHZRTN="DQPULL^AZHZCL"
- DO INIT
- IF (DFOUT!DUOUT)
- QUIT
- DQPULL ;ENTRY POINT FOR TASKING
- +1 SET ^AZHZTEMP="PULL"
- SET DFN=0
- +2 WRITE !,"EACH DOT =100 PATIENTS SET. THERE ARE ",^AZHZTEMP(0)," PATIENTS TO PROCESS",!,"STARTING AT "
- DO ^%T
- WRITE !
- DO DOIT
- +3 ;----kills old temp global prior to restore
- SET ^AZHZTEMP=""
- KILL ^AZHZTEMP
- GOTO EXIT
- +4 ;-------------------------------
- PRT ;ENTRY POINT: print report of edits to be performed
- +1 IF '$DATA(DUOUT)
- SET DUOUT=0
- IF '$DATA(DFOUT)
- SET DFOUT=0
- +2 ;-----
- IF (DUOUT!DFOUT)
- QUIT
- +3 IF '$DATA(^AZHZTEMP)
- WRITE *7,!,"<NO Compiled Edits Global Present>",!
- QUIT
- +4 ;----
- IF ^AZHZTEMP'=""
- WRITE *7,!,"< Sorry ",^AZHZTEMP," needs to be completed first >",!,*7
- GOTO EXIT
- +5 ;-----
- IF '$DATA(^AZHZTEMP("A",1))
- WRITE !,*7,"< SCAN must be completed First > ",!
- GOTO EXIT
- +6 SET AZHZHIT=0
- SET AZHZSET="O"
- SET AZHZHDR="IHS/VA PATIENT DATA BASE EDIT REPORT"
- SET AZHZRTN="DQPRT^AZHZCL"
- +7 DO INIT
- IF (DFOUT!DUOUT)
- QUIT
- DQPRT ;ENTRY POINT FOR TASKING
- +1 SET DFN=0
- +2 WRITE !,"THERE ARE ",^AZHZTEMP(0)," PATIENTS TO PRINT",!,"STARTING AT "
- DO ^%T
- WRITE !
- +3 WRITE !," Patient Name : DFN",!," Old Data to be Corrected : New Data Corrections ",!!
- +4 DO DOIT
- SET ^AZHZTEMP("A",2,"PRINTS PERFORMED")=""
- EPRT ;----
- GOTO EXIT
- +1 ;-------------------------------
- KILL ;ENTRY POINT kill ^AZHZTEMP
- +1 IF '$DATA(^AZHZTEMP)
- WRITE *7,!,"<NO Compiled Edits Global Present>",!
- QUIT
- +2 IF '$DATA(^AZHZTEMP("A",4))
- WRITE !,*7,"<AGPATCH HAS NOT BEEN SET YET>",!,*7
- QUIT
- +3 ;kill temp global
- KILL ^AZHZTEMP
- +4 ;----
- QUIT
- +5 ;-------------------------------
- AZHZPG ;EP
- +1 DO AZHZPG^AZHZCL1
- QUIT
- +2 ;-------------------------------
- DOIT DO ^AZHZCL1
- QUIT
- +1 ;-------------------------------
- INIT ;EP
- +1 DO INIT^AZHZCL1
- QUIT
- +2 ;-------------------------------
- EXIT ;EP
- +1 DO EXIT^AZHZCL1
- QUIT
- +2 ;-------------------------------
