AZHZCL1 ;DSD/PDW - PERFORM PRINTS,SETS,PULLS ; AUGUST 14, 1992
;;1.0;AZHZ;;AUG 14, 1992
;;
DOIT ;ENTRY POINT ; Loop through Compiled Edits global for Prints, Set edits, or Restore Data Base depending on the variables AZHZHIT,AZHZSET
Q:(DUOUT!DFOUT) ;-----
S AZHZ("B")="" I $D(^AZHZTEMP("LDFN")),+^AZHZTEMP("LDFN") S DFN=^("LDFN"),AZHZ("B")=^(DFN)
F AZHZCC=1:1 S AZHZ("B")=$O(^AZHZTEMP("B",AZHZ("B"))) Q:(DFOUT!DUOUT) Q:AZHZ("B")="" S DFN=0 F S DFN=$O(^AZHZTEMP("B",AZHZ("B"),DFN)) Q:(DFOUT!DUOUT) Q:'DFN D S ^AZHZTEMP("LDFN")=DFN
.U IO D AZHZPG W:'AZHZHIT !,^AZHZTEMP(DFN),?35,DFN
.;rescan prior to sets to insure old data still fails input transforms
.I AZHZHIT,AZHZSET="N" K ^AZHZTEMP(DFN) D SCDFN^AZHZCL Q:'$D(^AZHZTEMP(DFN)) ;-----
.F AZHZN="I","V" D DOIT2
.D OTH
.U IO D AZHZPG W:'(AZHZCC#100) "."
K ^AZHZTEMP("LDFN")
Q ;----
;---------------------------------------------------------------------
DOIT2 ; perform edits/prints
Q:(DUOUT!DFOUT) ;-----
S AZHZFLD="",DR="" F S AZHZFLD=$O(^AZHZTEMP(DFN,AZHZN,AZHZFLD)) Q:(DFOUT!DUOUT) Q:'AZHZFLD D
.S AZHZX1=^(AZHZFLD,"O"),AZHZX2=^("N"),AZHZX=^(AZHZSET) S:AZHZX="" AZHZX="@"
.I AZHZHIT,AZHZSET="O",AZHZX="@",((AZHZFLD=1110)!(AZHZFLD=1112)) S AZHZP=$S(AZHZFLD=1110:10,1:12),$P(^AUPNPAT(DFN,11),U,AZHZP)="" ; hard set necessary to delete these fields
.E S DR=DR_";"_AZHZFLD_"////"_AZHZX
.U IO D AZHZPG W:'AZHZHIT !,?5,AZHZT(AZHZFLD),?15,":",AZHZX1,?45,":",AZHZX2
.I $L(DR)>200 D DRDIE
I $L(DR) D DRDIE
Q ;----
;---------------------------------------------------------------------
DRDIE S DIE=$S(AZHZN="I":"^AUPNPAT(",1:"^DPT("),DA=DFN,DR=$E(DR,2,999) S:DIE["AUPN" DR=DR_";.03////"_DT D:AZHZHIT ^DIE ;W !,?15,DIE,DA," ",DR
S DR=""
EDOIT Q ;-----
;---------------------------------------------------------------------
OTH ;EP perform print/set of 'other names'
Q:(DFOUT!DUOUT) Q:'$D(^AZHZTEMP(DFN,"OTHER"))
S DA=0 F S DA=$O(^AZHZTEMP(DFN,"OTHER",DA)) Q:(DFOUT!DUOUT) Q:'DA S AZHZX=^AZHZTEMP(DFN,"OTHER",DA,.01,AZHZSET) S:AZHZX="" AZHZX="@" S DR=".01////"_AZHZX,AZHZX1=^("O"),AZHZX2=^("N") D
.U IO D AZHZPG W:'AZHZHIT !,?5,"OTHER",?15,":",AZHZX1,?45,":",AZHZX2
.S DA(1)=DFN,DIE="^DPT("_DFN_",.01," D:AZHZHIT ^DIE
.;W !,?15,DIE,DA," ",DR
EOTH Q ;-----
;---------------------------------------------------------------------
INIT ;ENTRY POINT ; INITIALIZE PARAMETERS
S:'$D(DUOUT) DUOUT=0 S:'$D(DFOUT) DFOUT=0
Q:(DUOUT!DFOUT) ;-----
Q:'$D(^AUTTSITE(1,0)) S AZHZSITE=+^(0),U="^"
I '$D(AZHZIOP) S IOP="HOME" D ^%ZIS,DT^DICRW
I '$D(AZHZIOP) S %ZIS="Q" D ^%ZIS I POP S (DFOUT,DUOUT)=1 Q
S IOM=80
I $D(IO("Q")) D QUE^AZHZCLN S (DFOUT,DUOUT)=1 Q
K AZHZPG D AZHZHDR W !,"Starting at " D ^%T W " " D ^%D W !
S AZHZX=$T(INITT) F I=2:1 S AZHZX1=$P(AZHZX,";;",I) Q:AZHZX1="" S AZHZX2=$P(AZHZX1,"^"),AZHZT(AZHZX2)=$P(AZHZX1,"^",2)
S (DUOUT,DFOUT)=0
Q ;-----
INITT ;;.01^NAME;;.09^SSN;;.111^ADD L1;;.112^ADD L2;;.113^ADD L3;;.114^ADD L4;;.211^NOK;;.2401^FA NAM;;.2402^MO NAM;;.2403^MO MAD;;1112^ELIG;;1109^TR QT;;1110^IN QT;;.331^EMR CON
;---------------------------------------------------------------------
EXIT ;ENTRY POINT kill variables and exit
U IO W !,"FINISHED AT " D ^%T H 3 K AZHZHDR D AZHZHDR I '$D(AZHZIOP) D ^%ZISC
K AZHZ,AZHZ11,AZHZB,AZHZCC,AZHZDAT,AZHZDR,AZHZDT,AZHZFAC,AZHZFACC,AZHZFLD,AZHZFLDN,AZHZGL,AZHZHDR,AZHZHIT,AZHZL,AZHZLFAC,AZHZLINE,AZHZLS,AZHZN,AZHZNODE,AZHZODR,AZHZAAP,AZHZAS
K AZHZP,AZHZPG,AZHZQI,AZHZQT,AZHZQTF,AZHZQTS,AZHZRUN,AZHZSET,AZHZSITE,AZHZT,AZHZTP,AZHZTS,AZHZX,AZHZX1,AZHZX2,AZHZZ
K AZHZASN,AZHZD,AZHZIEN,AZHZPN,AZHZQIS,AZHZS,AZHZSAN,AZHZXX,AZHZUSR,AZHZSASN,IEN,X,X1,X2,Y,I,AZHZVCC,%X,%Y
K AZHZRTN,AZHZX3,DUOUT,DFOUT,%,AZHZNAM,AZHZFN,AZHZLN,AZHZMN,AGOPT,AZHZBZ,AZHZXC
EEXIT Q
;---------------------------------------------------------------------
AZHZPG ;ENTRY POINT page controller
S:'$D(DUOUT) DUOUT=0 S:'$D(DFOUT) DFOUT=0
Q:($Y<(IOSL-4))!(DUOUT!DFOUT) S:'$D(AZHZPG) AZHZPG=0 S AZHZPG=AZHZPG+1 I $E(IOST)="C" R !,"^ to quit ",AZHZX:DTIME I $E(AZHZX)="^" S DUOUT=1,DFOUT=1 Q
AZHZHDR ; Header controller
W !,@IOF Q:'$D(AZHZHDR) S:'$D(AZHZLINE) $P(AZHZLINE,"-",IOM-2)="" S:'$D(AZHZPG) AZHZPG=1 I '$D(AZHZDT) D DT^DICRW S Y=DT D DD^%DT S AZHZDT=Y
U IO W ?(IOM-20-$L(AZHZHDR)/2),AZHZHDR,?(IOM-25),AZHZDT,?(IOM-10),"PAGE: ",AZHZPG,!,AZHZLINE
EAZHZPG Q ;-----
;---------------------------------------------------------------------
AZHZCL1 ;DSD/PDW - PERFORM PRINTS,SETS,PULLS ; AUGUST 14, 1992
+1 ;;1.0;AZHZ;;AUG 14, 1992
+2 ;;
DOIT ;ENTRY POINT ; Loop through Compiled Edits global for Prints, Set edits, or Restore Data Base depending on the variables AZHZHIT,AZHZSET
+1 ;-----
IF (DUOUT!DFOUT)
QUIT
+2 SET AZHZ("B")=""
IF $DATA(^AZHZTEMP("LDFN"))
IF +^AZHZTEMP("LDFN")
SET DFN=^("LDFN")
SET AZHZ("B")=^(DFN)
+3 FOR AZHZCC=1:1
SET AZHZ("B")=$ORDER(^AZHZTEMP("B",AZHZ("B")))
IF (DFOUT!DUOUT)
QUIT
IF AZHZ("B")=""
QUIT
SET DFN=0
FOR
SET DFN=$ORDER(^AZHZTEMP("B",AZHZ("B"),DFN))
IF (DFOUT!DUOUT)
QUIT
IF 'DFN
QUIT
Begin DoDot:1
+4 USE IO
DO AZHZPG
IF 'AZHZHIT
WRITE !,^AZHZTEMP(DFN),?35,DFN
+5 ;rescan prior to sets to insure old data still fails input transforms
+6 ;-----
IF AZHZHIT
IF AZHZSET="N"
KILL ^AZHZTEMP(DFN)
DO SCDFN^AZHZCL
IF '$DATA(^AZHZTEMP(DFN))
QUIT
+7 FOR AZHZN="I","V"
DO DOIT2
+8 DO OTH
+9 USE IO
DO AZHZPG
IF '(AZHZCC#100)
WRITE "."
End DoDot:1
SET ^AZHZTEMP("LDFN")=DFN
+10 KILL ^AZHZTEMP("LDFN")
+11 ;----
QUIT
+12 ;---------------------------------------------------------------------
DOIT2 ; perform edits/prints
+1 ;-----
IF (DUOUT!DFOUT)
QUIT
+2 SET AZHZFLD=""
SET DR=""
FOR
SET AZHZFLD=$ORDER(^AZHZTEMP(DFN,AZHZN,AZHZFLD))
IF (DFOUT!DUOUT)
QUIT
IF 'AZHZFLD
QUIT
Begin DoDot:1
+3 SET AZHZX1=^(AZHZFLD,"O")
SET AZHZX2=^("N")
SET AZHZX=^(AZHZSET)
IF AZHZX=""
SET AZHZX="@"
+4 ; hard set necessary to delete these fields
IF AZHZHIT
IF AZHZSET="O"
IF AZHZX="@"
IF ((AZHZFLD=1110)!(AZHZFLD=1112))
SET AZHZP=$SELECT(AZHZFLD=1110:10,1:12)
SET $PIECE(^AUPNPAT(DFN,11),U,AZHZP)=""
+5 IF '$TEST
SET DR=DR_";"_AZHZFLD_"////"_AZHZX
+6 USE IO
DO AZHZPG
IF 'AZHZHIT
WRITE !,?5,AZHZT(AZHZFLD),?15,":",AZHZX1,?45,":",AZHZX2
+7 IF $LENGTH(DR)>200
DO DRDIE
End DoDot:1
+8 IF $LENGTH(DR)
DO DRDIE
+9 ;----
QUIT
+10 ;---------------------------------------------------------------------
DRDIE ;W !,?15,DIE,DA," ",DR
SET DIE=$SELECT(AZHZN="I":"^AUPNPAT(",1:"^DPT(")
SET DA=DFN
SET DR=$EXTRACT(DR,2,999)
IF DIE["AUPN"
SET DR=DR_";.03////"_DT
IF AZHZHIT
DO ^DIE
+1 SET DR=""
EDOIT ;-----
QUIT
+1 ;---------------------------------------------------------------------
OTH ;EP perform print/set of 'other names'
+1 IF (DFOUT!DUOUT)
QUIT
IF '$DATA(^AZHZTEMP(DFN,"OTHER"))
QUIT
+2 SET DA=0
FOR
SET DA=$ORDER(^AZHZTEMP(DFN,"OTHER",DA))
IF (DFOUT!DUOUT)
QUIT
IF 'DA
QUIT
SET AZHZX=^AZHZTEMP(DFN,"OTHER",DA,.01,AZHZSET)
IF AZHZX=""
SET AZHZX="@"
SET DR=".01////"_AZHZX
SET AZHZX1=^("O")
SET AZHZX2=^("N")
Begin DoDot:1
+3 USE IO
DO AZHZPG
IF 'AZHZHIT
WRITE !,?5,"OTHER",?15,":",AZHZX1,?45,":",AZHZX2
+4 SET DA(1)=DFN
SET DIE="^DPT("_DFN_",.01,"
IF AZHZHIT
DO ^DIE
+5 ;W !,?15,DIE,DA," ",DR
End DoDot:1
EOTH ;-----
QUIT
+1 ;---------------------------------------------------------------------
INIT ;ENTRY POINT ; INITIALIZE PARAMETERS
+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 '$DATA(AZHZIOP)
SET IOP="HOME"
DO ^%ZIS
DO DT^DICRW
+5 IF '$DATA(AZHZIOP)
SET %ZIS="Q"
DO ^%ZIS
IF POP
SET (DFOUT,DUOUT)=1
QUIT
+6 SET IOM=80
+7 IF $DATA(IO("Q"))
DO QUE^AZHZCLN
SET (DFOUT,DUOUT)=1
QUIT
+8 KILL AZHZPG
DO AZHZHDR
WRITE !,"Starting at "
DO ^%T
WRITE " "
DO ^%D
WRITE !
+9 SET AZHZX=$TEXT(INITT)
FOR I=2:1
SET AZHZX1=$PIECE(AZHZX,";;",I)
IF AZHZX1=""
QUIT
SET AZHZX2=$PIECE(AZHZX1,"^")
SET AZHZT(AZHZX2)=$PIECE(AZHZX1,"^",2)
+10 SET (DUOUT,DFOUT)=0
+11 ;-----
QUIT
INITT ;;.01^NAME;;.09^SSN;;.111^ADD L1;;.112^ADD L2;;.113^ADD L3;;.114^ADD L4;;.211^NOK;;.2401^FA NAM;;.2402^MO NAM;;.2403^MO MAD;;1112^ELIG;;1109^TR QT;;1110^IN QT;;.331^EMR CON
+1 ;---------------------------------------------------------------------
EXIT ;ENTRY POINT kill variables and exit
+1 USE IO
WRITE !,"FINISHED AT "
DO ^%T
HANG 3
KILL AZHZHDR
DO AZHZHDR
IF '$DATA(AZHZIOP)
DO ^%ZISC
+2 KILL AZHZ,AZHZ11,AZHZB,AZHZCC,AZHZDAT,AZHZDR,AZHZDT,AZHZFAC,AZHZFACC,AZHZFLD,AZHZFLDN,AZHZGL,AZHZHDR,AZHZHIT,AZHZL,AZHZLFAC,AZHZLINE,AZHZLS,AZHZN,AZHZNODE,AZHZODR,AZHZAAP,AZHZAS
+3 KILL AZHZP,AZHZPG,AZHZQI,AZHZQT,AZHZQTF,AZHZQTS,AZHZRUN,AZHZSET,AZHZSITE,AZHZT,AZHZTP,AZHZTS,AZHZX,AZHZX1,AZHZX2,AZHZZ
+4 KILL AZHZASN,AZHZD,AZHZIEN,AZHZPN,AZHZQIS,AZHZS,AZHZSAN,AZHZXX,AZHZUSR,AZHZSASN,IEN,X,X1,X2,Y,I,AZHZVCC,%X,%Y
+5 KILL AZHZRTN,AZHZX3,DUOUT,DFOUT,%,AZHZNAM,AZHZFN,AZHZLN,AZHZMN,AGOPT,AZHZBZ,AZHZXC
EEXIT QUIT
+1 ;---------------------------------------------------------------------
AZHZPG ;ENTRY POINT page controller
+1 IF '$DATA(DUOUT)
SET DUOUT=0
IF '$DATA(DFOUT)
SET DFOUT=0
+2 IF ($Y<(IOSL-4))!(DUOUT!DFOUT)
QUIT
IF '$DATA(AZHZPG)
SET AZHZPG=0
SET AZHZPG=AZHZPG+1
IF $EXTRACT(IOST)="C"
READ !,"^ to quit ",AZHZX:DTIME
IF $EXTRACT(AZHZX)="^"
SET DUOUT=1
SET DFOUT=1
QUIT
AZHZHDR ; Header controller
+1 WRITE !,@IOF
IF '$DATA(AZHZHDR)
QUIT
IF '$DATA(AZHZLINE)
SET $PIECE(AZHZLINE,"-",IOM-2)=""
IF '$DATA(AZHZPG)
SET AZHZPG=1
IF '$DATA(AZHZDT)
DO DT^DICRW
SET Y=DT
DO DD^%DT
SET AZHZDT=Y
+2 USE IO
WRITE ?(IOM-20-$LENGTH(AZHZHDR)/2),AZHZHDR,?(IOM-25),AZHZDT,?(IOM-10),"PAGE: ",AZHZPG,!,AZHZLINE
EAZHZPG ;-----
QUIT
+1 ;---------------------------------------------------------------------
