AZHZCLN ;DSD/PDW - MASTER ROUTINE TO CLEAN THE VA/IHS PATIENT BASE ; AUGUST 14, 1992
;;1.0;AZHZ;;AUG 14, 1992
;;
S ;
D DT^DICRW S IOP="HOME" D ^%ZIS
K AZHZIOP
DUZ I '$G(DUZ) W !,"You must identify yourself first .. Please ?",! D ^XUP I '$G(DUZ) Q
S DIR(0)="S^1:Scan & Compile Edits to Perform;2:Print Edits to Perform;3:Perform Edits;4:Set Trans' Nodes;5:Print ()&/ Edits;6:Kill Edits Global;7:EXIT;8:Restore Compiled Edits Global;9:Restore Data Base;10:VIEW;11:FACE;12:STEPS 1-5"
S DIR("B")=0 I $D(^AZHZTEMP("A")) S X=0 F S X=$O(^AZHZTEMP("A",X)) Q:'X S DIR("B")=X
S DIR("B")=DIR("B")+1
D ^DIR S AZHZMEN=X Q:("^"[$E(X))
I $D(DTOUT),DTOUT Q
I +X'=X W !,*7,"Please use the Numbers",! G S
G:X=12 ALL
S (DUOUT,DFOUT)=0
D @($P("^AZHZCL;;PRT^AZHZCL;;SET^AZHZCL;;^AZHZCLAG;;PUNC;;KILL^AZHZCL;;EXIT^AZHZCL;;RES^AZHZCLN;;PULL^AZHZCL;;VIEW;;FAC;;ALL",";;",X))
G:AZHZMEN'=7 S
D ^%ZISC D EXIT K AZHZMEN,AZHZIOP Q ;-----
;----------------------------------------------------------------------
SAV ;ENTRY POINT save Compiled Edits Global
I '$D(^AZHZSAV) W !,"SAVING IMAGE",! S %X="^AZHZTEMP(",%Y="^AZHZSAV(" D %XY^%RCR Q ;-----
Q
;----------------------------------------------------------------------
RES ;ENTRY POINT restore Compiled Edits Global
I '$D(^AZHZSAV) W *7,"<< ERROR .. ^AZHZSAV does not exist ! >>",! Q ;-----
K ^AZHZTEMP ;kill temp global prior to restore
S %X="^AZHZSAV(",%Y="^AZHZTEMP(" D %XY^%RCR S ^AZHZTEMP=""
Q ;-----
;----------------------------------------------------------------------
VIEW ; VIEW ANY PATIENT
S AUPNLK("ALL")="" D ^AGSEENLY
K AUPNLK("ALL") Q ;-----
FAC ; FACE SHEET PRINT
S X="AGFACE",AUPNLK("ALL")="" D HDR^AG,^AGVAR:'$D(AGOPT),^AGFACE
K AUPNLK("ALL") Q ;-----
;----------------------------------------------------------------------
PUNC ;EP
PUNPRT ;ENTRY POINT to print names that had punctuation "()&/" removed
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 ( ) & / REPORT",AZHZRTN="DQPPRT^AZHZCLN"
D INIT Q:(DFOUT!DUOUT)
DQPPRT ;ENTRY POINT FOR TASKING
Q:(DUOUT!DFOUT) ;-----
S DFN=0 F AZHZCC=0:1 S DFN=$O(^AZHZTEMP("P",DFN)) Q:'+DFN
S ^AZHZTEMP("P",0)=AZHZCC,DFN=0
W !,"THERE ARE ",^AZHZTEMP("P",0)," PATIENTS TO PRINT",!,"STARTING AT " D ^%T W !
W !," Patient Name : DFN",!," Old Data to be Corrected : New Data Corrections ",!!
23 F S DFN=$O(^AZHZTEMP("P",DFN)) Q:'+DFN D
.U IO D AZHZPG W:'AZHZHIT !,^AZHZTEMP(DFN),?35,DFN
.F AZHZN="I","V" D DOIT2^AZHZCL1
.D OTH^AZHZCL1
EPUN G EXIT ;----
;----------------------------------------------------------------------
ALL ; perform steps 1-5
W !,"This will automatically process steps 1-5 and then exit"
W !,"It is advised that a printer type device be selected",!
K AZHZIOP,ZTSK S AZHZRTN="DQALL^AZHZCLN"
D INIT^AZHZCL S AZHZIOP=ION_";"_IOST_";"_IOM_";"_IOSL
I (DUOUT!DFOUT!POP) K AZHZIOP,AZHZMEN D EXIT Q ;-----
I $D(ZTSK) K AZHZIOP,AZHZMEN D EXIT Q ;-----
;
DQALL ;ENTRY POINT FOR TASKING
D ^AZHZCL,PRT^AZHZCL,SET^AZHZCL,^AZHZCLAG,PUNC^AZHZCLN
D ^%ZISC K AZHZIOP,AZHZMEN
Q
;----------------------------------------------------------------------
QUE ;ENTRY POINT from the INIT^AZHZCL1
;the routine entry for tasking is held in the variable AZHZRTN
S ZTRTN="DEQUE^AZHZCLN",ZTDESC="QUE OF AZHZCLEAN "_AZHZRTN,ZTSAVE("AZHZ*")=""
S AZHZIOP=ION_";"_IOST_";"_IOM_";"_IOSL
I ION["HOST" S AZHZ("IOPAR")=IOPAR
D ^%ZTLOAD,^%ZISC I $G(ZTSK) W !,"Tasked with number : ",ZTSK,!
Q
;----------------------------------------------------------------------
DEQUE ;ENTRY POINT FOR DEQUE
;the routine entry for tasking is held in the variable AZHZRTN
I ION["HOST",$D(AZHZ("IOPAR")) S IOP=ION,%ZIS("IOPAR")=AZHZ("IOPAR") D ^%ZIS
D INIT^AZHZCL1,@AZHZRTN D EXIT^AZHZCL1
Q
;----------------------------------------------------------------------
EXIT D EXIT^AZHZCL1 Q
;----------------------------------------------------------------------
INIT D INIT^AZHZCL1 Q
;----------------------------------------------------------------------
AZHZPG D AZHZPG^AZHZCL Q
;----------------------------------------------------------------------
AZHZCLN ;DSD/PDW - MASTER ROUTINE TO CLEAN THE VA/IHS PATIENT BASE ; AUGUST 14, 1992
+1 ;;1.0;AZHZ;;AUG 14, 1992
+2 ;;
S ;
+1 DO DT^DICRW
SET IOP="HOME"
DO ^%ZIS
+2 KILL AZHZIOP
DUZ IF '$GET(DUZ)
WRITE !,"You must identify yourself first .. Please ?",!
DO ^XUP
IF '$GET(DUZ)
QUIT
+1 SET DIR(0)="S^1:Scan & Compile Edits to Perform;2:Print Edits to Perform;3:Perform Edits;4:Set Trans' Nodes;5:Print ()&/ Edits;6:Kill Edits Global;7:EXIT;8:Restore Compiled Edits Global;9:Restore Data Base;10:VIEW;11:FACE;12:STEPS 1-5"
+2 SET DIR("B")=0
IF $DATA(^AZHZTEMP("A"))
SET X=0
FOR
SET X=$ORDER(^AZHZTEMP("A",X))
IF 'X
QUIT
SET DIR("B")=X
+3 SET DIR("B")=DIR("B")+1
+4 DO ^DIR
SET AZHZMEN=X
IF ("^"[$EXTRACT(X))
QUIT
+5 IF $DATA(DTOUT)
IF DTOUT
QUIT
+6 IF +X'=X
WRITE !,*7,"Please use the Numbers",!
GOTO S
+7 IF X=12
GOTO ALL
+8 SET (DUOUT,DFOUT)=0
+9 DO @($PIECE("^AZHZCL;;PRT^AZHZCL;;SET^AZHZCL;;^AZHZCLAG;;PUNC;;KILL^AZHZCL;;EXIT^AZHZCL;;RES^AZHZCLN;;PULL^AZHZCL;;VIEW;;FAC;;ALL",";;",X))
+10 IF AZHZMEN'=7
GOTO S
+11 ;-----
DO ^%ZISC
DO EXIT
KILL AZHZMEN,AZHZIOP
QUIT
+12 ;----------------------------------------------------------------------
SAV ;ENTRY POINT save Compiled Edits Global
+1 ;-----
IF '$DATA(^AZHZSAV)
WRITE !,"SAVING IMAGE",!
SET %X="^AZHZTEMP("
SET %Y="^AZHZSAV("
DO %XY^%RCR
QUIT
+2 QUIT
+3 ;----------------------------------------------------------------------
RES ;ENTRY POINT restore Compiled Edits Global
+1 ;-----
IF '$DATA(^AZHZSAV)
WRITE *7,"<< ERROR .. ^AZHZSAV does not exist ! >>",!
QUIT
+2 ;kill temp global prior to restore
KILL ^AZHZTEMP
+3 SET %X="^AZHZSAV("
SET %Y="^AZHZTEMP("
DO %XY^%RCR
SET ^AZHZTEMP=""
+4 ;-----
QUIT
+5 ;----------------------------------------------------------------------
VIEW ; VIEW ANY PATIENT
+1 SET AUPNLK("ALL")=""
DO ^AGSEENLY
+2 ;-----
KILL AUPNLK("ALL")
QUIT
FAC ; FACE SHEET PRINT
+1 SET X="AGFACE"
SET AUPNLK("ALL")=""
DO HDR^AG
IF '$DATA(AGOPT)
DO ^AGVAR
DO ^AGFACE
+2 ;-----
KILL AUPNLK("ALL")
QUIT
+3 ;----------------------------------------------------------------------
PUNC ;EP
PUNPRT ;ENTRY POINT to print names that had punctuation "()&/" removed
+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 ( ) & / REPORT"
SET AZHZRTN="DQPPRT^AZHZCLN"
+7 DO INIT
IF (DFOUT!DUOUT)
QUIT
DQPPRT ;ENTRY POINT FOR TASKING
+1 ;-----
IF (DUOUT!DFOUT)
QUIT
+2 SET DFN=0
FOR AZHZCC=0:1
SET DFN=$ORDER(^AZHZTEMP("P",DFN))
IF '+DFN
QUIT
+3 SET ^AZHZTEMP("P",0)=AZHZCC
SET DFN=0
+4 WRITE !,"THERE ARE ",^AZHZTEMP("P",0)," PATIENTS TO PRINT",!,"STARTING AT "
DO ^%T
WRITE !
+5 WRITE !," Patient Name : DFN",!," Old Data to be Corrected : New Data Corrections ",!!
23 FOR
SET DFN=$ORDER(^AZHZTEMP("P",DFN))
IF '+DFN
QUIT
Begin DoDot:1
+1 USE IO
DO AZHZPG
IF 'AZHZHIT
WRITE !,^AZHZTEMP(DFN),?35,DFN
+2 FOR AZHZN="I","V"
DO DOIT2^AZHZCL1
+3 DO OTH^AZHZCL1
End DoDot:1
EPUN ;----
GOTO EXIT
+1 ;----------------------------------------------------------------------
ALL ; perform steps 1-5
+1 WRITE !,"This will automatically process steps 1-5 and then exit"
+2 WRITE !,"It is advised that a printer type device be selected",!
+3 KILL AZHZIOP,ZTSK
SET AZHZRTN="DQALL^AZHZCLN"
+4 DO INIT^AZHZCL
SET AZHZIOP=ION_";"_IOST_";"_IOM_";"_IOSL
+5 ;-----
IF (DUOUT!DFOUT!POP)
KILL AZHZIOP,AZHZMEN
DO EXIT
QUIT
+6 ;-----
IF $DATA(ZTSK)
KILL AZHZIOP,AZHZMEN
DO EXIT
QUIT
+7 ;
DQALL ;ENTRY POINT FOR TASKING
+1 DO ^AZHZCL
DO PRT^AZHZCL
DO SET^AZHZCL
DO ^AZHZCLAG
DO PUNC^AZHZCLN
+2 DO ^%ZISC
KILL AZHZIOP,AZHZMEN
+3 QUIT
+4 ;----------------------------------------------------------------------
QUE ;ENTRY POINT from the INIT^AZHZCL1
+1 ;the routine entry for tasking is held in the variable AZHZRTN
+2 SET ZTRTN="DEQUE^AZHZCLN"
SET ZTDESC="QUE OF AZHZCLEAN "_AZHZRTN
SET ZTSAVE("AZHZ*")=""
+3 SET AZHZIOP=ION_";"_IOST_";"_IOM_";"_IOSL
+4 IF ION["HOST"
SET AZHZ("IOPAR")=IOPAR
+5 DO ^%ZTLOAD
DO ^%ZISC
IF $GET(ZTSK)
WRITE !,"Tasked with number : ",ZTSK,!
+6 QUIT
+7 ;----------------------------------------------------------------------
DEQUE ;ENTRY POINT FOR DEQUE
+1 ;the routine entry for tasking is held in the variable AZHZRTN
+2 IF ION["HOST"
IF $DATA(AZHZ("IOPAR"))
SET IOP=ION
SET %ZIS("IOPAR")=AZHZ("IOPAR")
DO ^%ZIS
+3 DO INIT^AZHZCL1
DO @AZHZRTN
DO EXIT^AZHZCL1
+4 QUIT
+5 ;----------------------------------------------------------------------
EXIT DO EXIT^AZHZCL1
QUIT
+1 ;----------------------------------------------------------------------
INIT DO INIT^AZHZCL1
QUIT
+1 ;----------------------------------------------------------------------
AZHZPG DO AZHZPG^AZHZCL
QUIT
+1 ;----------------------------------------------------------------------
