Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: AUP2POST

AUP2POST.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. D ^XBKVAR
  1. W !!,"This routine will kill and re-index 5 'AQ' (QMAN) cross references.",!
  1. W "That process may take several hours, you will be given the opportunity",!,"to queue the re-indexing.",!!
  1. S DIR(0)="Y",DIR("A")="Do you want to continue",DIR("B")="Y" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1. I $D(DIRUT)!('Y) W !!,"YOU MUST RUN THIS ROUTINE (AUP2POST) SOMETIME!!!",!,$C(7),$C(7) G XIT
  1. QUEUE ;
  1. K ZTSK
  1. 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
  1. I Y=1 D TSKMN Q
  1. I $D(DIRUT) W !,"Okay, you '^'ed out or timed out so I'm quitting.",! D XIT Q
  1. DRIVER ;
  1. ;
  1. VIMM ;
  1. K ^AUPNVIMM("AQ")
  1. W:'$D(ZTQUEUED) !!,"Re-indexing the AQ cross reference on V Immunization. Hold on...."
  1. S DIK="^AUPNVIMM(",DIK(1)=".01^AQTOO" D ENALL^DIK
  1. K DIK,DA,D0
  1. VDXP ;
  1. I '$D(ZTQUEUED) W !!,"Re-indexing AQ on V DIAGNOSTIC PROCEDURE RESULT",!
  1. 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 "."
  1. VXAM ;re-index AQ on V exam
  1. I '$D(ZTQUEUED) W !!,"Re-indexing AQ on V EXAM",!
  1. 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 "."
  1. VSK ;re-index aq on v skin test
  1. I '$D(ZTQUEUED) W !!,"Re-indexing AQ on V SKIN TEST",!
  1. 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 "."
  1. VRAD ;
  1. I '$D(ZTQUEUED) W !!,"Re-indexing AQ on V RADIOLOGY",!
  1. 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 "."
  1. VLAB ;
  1. I '$D(ZTQUEUED) W !!,"Re-indexing AQ on V LAB",!
  1. 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 "."
  1. W !!,"ALL DONE"
  1. D XIT
  1. Q
  1. TSKMN ;
  1. S ZTIO="",ZTRTN="DRIVER^AUP2POST",ZTDTH="",ZTDESC="AUPN PATCH 2 -93.2 RE-INDEX" D ^%ZTLOAD D XIT K ZTSK Q
  1. XIT ;
  1. K AUPNX
  1. K DIR,DIC,X,Y,DIRUT
  1. Q