AUP2POST ; TUCSON/LAB - POST INIT TO AUP2 ; [ 01/03/95 10:27 AM ]
;;93.2;AUP2 - PATCH 2 TO AUPN 93.2;*2*;JAN 03, 1995
;
D ^XBKVAR
W !!,"This routine will kill and re-index 5 'AQ' (QMAN) cross references.",!
W "That process may take several hours, you will be given the opportunity",!,"to queue the re-indexing.",!!
S DIR(0)="Y",DIR("A")="Do you want to continue",DIR("B")="Y" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT)!('Y) W !!,"YOU MUST RUN THIS ROUTINE (AUP2POST) SOMETIME!!!",!,$C(7),$C(7) G XIT
QUEUE ;
K ZTSK
S DIR(0)="Y",DIR("A")="Do you want to QUEUE this to run in the background",DIR("B")="N" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I Y=1 D TSKMN Q
I $D(DIRUT) W !,"Okay, you '^'ed out or timed out so I'm quitting.",! D XIT Q
DRIVER ;
;
VIMM ;
K ^AUPNVIMM("AQ")
W:'$D(ZTQUEUED) !!,"Re-indexing the AQ cross reference on V Immunization. Hold on...."
S DIK="^AUPNVIMM(",DIK(1)=".01^AQTOO" D ENALL^DIK
K DIK,DA,D0
VDXP ;
I '$D(ZTQUEUED) W !!,"Re-indexing AQ on V DIAGNOSTIC PROCEDURE RESULT",!
K ^AUPNVDXP("AQ") S AUPNX=0 F S AUPNX=$O(^AUPNVDXP(AUPNX)) Q:AUPNX'=+AUPNX I $D(^AUPNVDXP(AUPNX,0)) S DA=AUPNX,X=$P(^AUPNVDXP(AUPNX,0),U,1),AUPNDXQF="S1" D ^AUPNVDXP I '$D(ZTQUEUED),'(AUPNX#100) W "."
VXAM ;re-index AQ on V exam
I '$D(ZTQUEUED) W !!,"Re-indexing AQ on V EXAM",!
K ^AUPNVXAM("AQ") S AUPNX=0 F S AUPNX=$O(^AUPNVXAM(AUPNX)) Q:AUPNX'=+AUPNX I $D(^AUPNVXAM(AUPNX,0)) S DA=AUPNX,X=$P(^AUPNVXAM(AUPNX,0),U,1) D AQE1^AUPNCIXL I '$D(ZTQUEUED),'(AUPNX#100) W "."
VSK ;re-index aq on v skin test
I '$D(ZTQUEUED) W !!,"Re-indexing AQ on V SKIN TEST",!
K ^AUPNVSK("AQ") S AUPNX=0 F S AUPNX=$O(^AUPNVSK(AUPNX)) Q:AUPNX'=+AUPNX I $D(^AUPNVSK(AUPNX,0)) S DA=AUPNX,X=$P(^AUPNVSK(AUPNX,0),U,1) D AQS1^AUPNCIXL I '$D(ZTQUEUED),'(AUPNX#100) W "."
VRAD ;
I '$D(ZTQUEUED) W !!,"Re-indexing AQ on V RADIOLOGY",!
K ^AUPNVRAD("AQ") S AUPNX=0 F S AUPNX=$O(^AUPNVRAD(AUPNX)) Q:AUPNX'=+AUPNX I $D(^AUPNVRAD(AUPNX,0)) S DA=AUPNX,X=$P(^AUPNVRAD(AUPNX,0),U,1) D AQR1^AUPNCIXL I '$D(ZTQUEUED),'(AUPNX#100) W "."
VLAB ;
I '$D(ZTQUEUED) W !!,"Re-indexing AQ on V LAB",!
K ^AUPNVLAB("AQ") S AUPNX=0 F S AUPNX=$O(^AUPNVLAB(AUPNX)) Q:AUPNX'=+AUPNX I $D(^AUPNVLAB(AUPNX,0)) S DA=AUPNX,X=$P(^AUPNVLAB(AUPNX,0),U,1) D AQ1^AUPNCIXL I '$D(ZTQUEUED),'(AUPNX#100) W "."
W !!,"ALL DONE"
D XIT
Q
TSKMN ;
S ZTIO="",ZTRTN="DRIVER^AUP2POST",ZTDTH="",ZTDESC="AUPN PATCH 2 -93.2 RE-INDEX" D ^%ZTLOAD D XIT K ZTSK Q
XIT ;
K AUPNX
K DIR,DIC,X,Y,DIRUT
Q
AUP2POST ; TUCSON/LAB - POST INIT TO AUP2 ; [ 01/03/95 10:27 AM ]
+1 ;;93.2;AUP2 - PATCH 2 TO AUPN 93.2;*2*;JAN 03, 1995
+2 ;
+3 DO ^XBKVAR
+4 WRITE !!,"This routine will kill and re-index 5 'AQ' (QMAN) cross references.",!
+5 WRITE "That process may take several hours, you will be given the opportunity",!,"to queue the re-indexing.",!!
+6 SET DIR(0)="Y"
SET DIR("A")="Do you want to continue"
SET DIR("B")="Y"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+7 IF $DATA(DIRUT)!('Y)
WRITE !!,"YOU MUST RUN THIS ROUTINE (AUP2POST) SOMETIME!!!",!,$CHAR(7),$CHAR(7)
GOTO XIT
QUEUE ;
+1 KILL ZTSK
+2 SET DIR(0)="Y"
SET DIR("A")="Do you want to QUEUE this to run in the background"
SET DIR("B")="N"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+3 IF Y=1
DO TSKMN
QUIT
+4 IF $DATA(DIRUT)
WRITE !,"Okay, you '^'ed out or timed out so I'm quitting.",!
DO XIT
QUIT
DRIVER ;
+1 ;
VIMM ;
+1 KILL ^AUPNVIMM("AQ")
+2 IF '$DATA(ZTQUEUED)
WRITE !!,"Re-indexing the AQ cross reference on V Immunization. Hold on...."
+3 SET DIK="^AUPNVIMM("
SET DIK(1)=".01^AQTOO"
DO ENALL^DIK
+4 KILL DIK,DA,D0
VDXP ;
+1 IF '$DATA(ZTQUEUED)
WRITE !!,"Re-indexing AQ on V DIAGNOSTIC PROCEDURE RESULT",!
+2 KILL ^AUPNVDXP("AQ")
SET AUPNX=0
FOR
SET AUPNX=$ORDER(^AUPNVDXP(AUPNX))
IF AUPNX'=+AUPNX
QUIT
IF $DATA(^AUPNVDXP(AUPNX,0))
SET DA=AUPNX
SET X=$PIECE(^AUPNVDXP(AUPNX,0),U,1)
SET AUPNDXQF="S1"
DO ^AUPNVDXP
IF '$DATA(ZTQUEUED)
IF '(AUPNX#100)
WRITE "."
VXAM ;re-index AQ on V exam
+1 IF '$DATA(ZTQUEUED)
WRITE !!,"Re-indexing AQ on V EXAM",!
+2 KILL ^AUPNVXAM("AQ")
SET AUPNX=0
FOR
SET AUPNX=$ORDER(^AUPNVXAM(AUPNX))
IF AUPNX'=+AUPNX
QUIT
IF $DATA(^AUPNVXAM(AUPNX,0))
SET DA=AUPNX
SET X=$PIECE(^AUPNVXAM(AUPNX,0),U,1)
DO AQE1^AUPNCIXL
IF '$DATA(ZTQUEUED)
IF '(AUPNX#100)
WRITE "."
VSK ;re-index aq on v skin test
+1 IF '$DATA(ZTQUEUED)
WRITE !!,"Re-indexing AQ on V SKIN TEST",!
+2 KILL ^AUPNVSK("AQ")
SET AUPNX=0
FOR
SET AUPNX=$ORDER(^AUPNVSK(AUPNX))
IF AUPNX'=+AUPNX
QUIT
IF $DATA(^AUPNVSK(AUPNX,0))
SET DA=AUPNX
SET X=$PIECE(^AUPNVSK(AUPNX,0),U,1)
DO AQS1^AUPNCIXL
IF '$DATA(ZTQUEUED)
IF '(AUPNX#100)
WRITE "."
VRAD ;
+1 IF '$DATA(ZTQUEUED)
WRITE !!,"Re-indexing AQ on V RADIOLOGY",!
+2 KILL ^AUPNVRAD("AQ")
SET AUPNX=0
FOR
SET AUPNX=$ORDER(^AUPNVRAD(AUPNX))
IF AUPNX'=+AUPNX
QUIT
IF $DATA(^AUPNVRAD(AUPNX,0))
SET DA=AUPNX
SET X=$PIECE(^AUPNVRAD(AUPNX,0),U,1)
DO AQR1^AUPNCIXL
IF '$DATA(ZTQUEUED)
IF '(AUPNX#100)
WRITE "."
VLAB ;
+1 IF '$DATA(ZTQUEUED)
WRITE !!,"Re-indexing AQ on V LAB",!
+2 KILL ^AUPNVLAB("AQ")
SET AUPNX=0
FOR
SET AUPNX=$ORDER(^AUPNVLAB(AUPNX))
IF AUPNX'=+AUPNX
QUIT
IF $DATA(^AUPNVLAB(AUPNX,0))
SET DA=AUPNX
SET X=$PIECE(^AUPNVLAB(AUPNX,0),U,1)
DO AQ1^AUPNCIXL
IF '$DATA(ZTQUEUED)
IF '(AUPNX#100)
WRITE "."
+3 WRITE !!,"ALL DONE"
+4 DO XIT
+5 QUIT
TSKMN ;
+1 SET ZTIO=""
SET ZTRTN="DRIVER^AUP2POST"
SET ZTDTH=""
SET ZTDESC="AUPN PATCH 2 -93.2 RE-INDEX"
DO ^%ZTLOAD
DO XIT
KILL ZTSK
QUIT
XIT ;
+1 KILL AUPNX
+2 KILL DIR,DIC,X,Y,DIRUT
+3 QUIT
