- 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