- 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 ;----------------------------------------------------------------------
