AMQQMGR1 ;IHS/CMI/THL - CHECKS AND SETS THE 'AQ' XREF ;
;;2.0;IHS PCC SUITE;**2**;MAY 14, 2009
;-----
W:$D(IOF) @IOF
START I '$D(^AUTTSITE(1,0)) W !!,"RPMS SITE PARAMETER FILE NOT PRESENT...REQUEST CANCELLED"
I $P(^AUTTSITE(1,0),U,19)'="Y" D NEW G EXIT
W !!,"Q-Man indices are active!",!!!
W ?3,"V EXAM 'AQ' index is "
W:'$D(^AUPNVXAM("AQ")) "not "
W "present",!
W ?3,"V NUTRITION RISK SCREENING 'AQ' index is " ;PATCH XXX
W:'$D(^AUPNVNTS("AQ")) "not "
W "present",!
W ?3,"The INDIAN BLOOD QUANTUM 'AQ1' index of the PATIENT file is "
W:'$D(^AUPNPAT("AQ1")) "not "
W "present",!
W ?3,"V IMMUNIZATION 'AQ' index is "
W:'$D(^AUPNVIMM("AQ")) "not "
W "present",!
W ?3,"V LAB 'AQ' index is "
W:'$D(^AUPNVLAB("AQ")) "not "
W "present",!
W ?3,"V MEASUREMENT 'AQ' index is "
W:'$D(^AUPNVMSR("AQ")) "not "
W "present",!
W ?3,"V SKIN TEST 'AQ' index is "
W:'$D(^AUPNVSK("AQ")) "not "
W "present",!
W !!!
S DIR(0)="E"
D ^DIR
K DIRUT,DUOUT,DTOUT,DIR
EXIT K %Y
Q
;
NEW W !!,"Q-Man indices have not been activated!",!!
W "I can create the Q-Man indices now. This will significantly improve the",!
W "performance of Q-Man and reduce stress on the CPU. However, the new indices",!
W "will increase the size of the PCC database by approximately 1%"
W !!,"Want me to create the indices?"
S %=0
D YN^DICN
K DIR,%
I $E(%Y)=U!("Yy"'[%Y)!(%Y="")!($D(DUOUT))!($D(DTOUT)) K DUOUT,DTOUT,%Y Q
W !,"OK, I'll run the job in background. This job will take 1-72 hours to complete.",!!
MAILTASK S ZTRTN="JOB^AMQQMGR1"
S ZTDTH="NOW"
S ZTIO=""
S ZTDESC="CREATE Q-MAN INDICES"
D ^%ZTLOAD
W !!,$S($D(ZTSK):"Request queued!",1:"Request cancelled!"),!!!
H 3
Q
;
JOB ;
S G=U_"AUTTSITE"
S $P(@G@(1,0),U,19)="Y"
K G,AMQQAQF
I $P($G(^AUTTSITE(1,0)),U,19)'="Y" Q
;
VIMM ; re-indexing v immunization
K ^AUPNVIMM("AQ")
S DIK="^AUPNVIMM("
S DIK(1)=".01^AQTOO"
D ENALL^DIK
K DIK
;
PAT ; re-indexing aq1 on Patient
K AUPNPAT("AQ1")
F DA=0:0 S DA=$O(^AUPNPAT(DA)) Q:'DA S X=$P($G(^(DA,11)),U,10) K AMQQQXR D QXR I $D(AMQQQXR) S ^AUPNPAT("AQ1",AMQQQXR,DA)=""
;
VMSR ; re-indexing aq on v measurement
K ^AUPNVMSR("AQ")
F DA=0:0 S DA=$O(^AUPNVMSR(DA)) Q:'DA S AUPNCIXF="S",AUPNCIXV=$G(^(DA,0)),X=$P(AUPNCIXV,U,4) I X'="" D VMSR04^AUPNCIX
;
VDXP ; Re-indexing AQ on V DIAGNOSTIC PROCEDURE RESULT
K ^AUPNVDXP("AQ")
S AMQQX=0
F S AMQQX=$O(^AUPNVDXP(AMQQX)) Q:AMQQX'=+AMQQX I $D(^AUPNVDXP(AMQQX,0)) S DA=AMQQX,X=$P(^AUPNVDXP(AMQQX,0),U,1),AUPNDXQF="S1" D ^AUPNVDXP
;
VXAM ;re-index AQ on V exam
K ^AUPNVXAM("AQ")
S AMQQX=0
F S AMQQX=$O(^AUPNVXAM(AMQQX)) Q:AMQQX'=+AMQQX I $D(^AUPNVXAM(AMQQX,0)) S DA=AMQQX,X=$P(^AUPNVXAM(AMQQX,0),U,1) D AQE1^AUPNCIXL
K ^AUPNVNTS("AQ")
S AMQQX=0
F S AMQQX=$O(^AUPNVNTS(AMQQX)) Q:AMQQX'=+AMQQX I $D(^AUPNVNTS(AMQQX,0)) S DA=AMQQX,X=$P(^AUPNVNTS(AMQQX,0),U,1) D AQE1^AUPNCIXL
;
VSK ;re-index aq on v skin test
K ^AUPNVSK("AQ")
S AMQQX=0
F S AMQQX=$O(^AUPNVSK(AMQQX)) Q:AMQQX'=+AMQQX I $D(^AUPNVSK(AMQQX,0)) S DA=AMQQX,X=$P(^AUPNVSK(AMQQX,0),U,1) D AQS1^AUPNCIXL
;
VRAD ; re-index aq on v radiology
K ^AUPNVRAD("AQ")
S AMQQX=0
F S AMQQX=$O(^AUPNVRAD(AMQQX)) Q:AMQQX'=+AMQQX I $D(^AUPNVRAD(AMQQX,0)) S DA=AMQQX,X=$P(^AUPNVRAD(AMQQX,0),U,1) D AQR1^AUPNCIXL
;
VLAB ; re-index aq on v lab
K ^AUPNVLAB("AQ")
S AMQQX=0
F S AMQQX=$O(^AUPNVLAB(AMQQX)) Q:AMQQX'=+AMQQX I $D(^AUPNVLAB(AMQQX,0)) S DA=AMQQX,X=$P(^AUPNVLAB(AMQQX,0),U,1) D AQ1^AUPNCIXL
;
KILL K AMQQX,DA,DIE,DIK,AUPNDXQF
Q
;
QXR ; ENTRY POINT
I X="" Q
N %
S %=X
N X
I %["/" S %=(+%/$S($P(%,"/",2):$P(%,"/",2),1:1)) S:$E(%)="." %=0_%,AMQQQXR=$E(%,1,5)+1 S:'$D(AMQQQXR) AMQQQXR=%+1 Q
S %=$S($E(%)="F":2,$E(%)="N":1,$E(%,1,3)="UNK":2.1,$E(%,1,3)="UNS":2.2,1:"")
I %'="" S AMQQQXR=%
Q
;
AMQQMGR1 ;IHS/CMI/THL - CHECKS AND SETS THE 'AQ' XREF ;
+1 ;;2.0;IHS PCC SUITE;**2**;MAY 14, 2009
+2 ;-----
+3 IF $DATA(IOF)
WRITE @IOF
START IF '$DATA(^AUTTSITE(1,0))
WRITE !!,"RPMS SITE PARAMETER FILE NOT PRESENT...REQUEST CANCELLED"
+1 IF $PIECE(^AUTTSITE(1,0),U,19)'="Y"
DO NEW
GOTO EXIT
+2 WRITE !!,"Q-Man indices are active!",!!!
+3 WRITE ?3,"V EXAM 'AQ' index is "
+4 IF '$DATA(^AUPNVXAM("AQ"))
WRITE "not "
+5 WRITE "present",!
+6 ;PATCH XXX
WRITE ?3,"V NUTRITION RISK SCREENING 'AQ' index is "
+7 IF '$DATA(^AUPNVNTS("AQ"))
WRITE "not "
+8 WRITE "present",!
+9 WRITE ?3,"The INDIAN BLOOD QUANTUM 'AQ1' index of the PATIENT file is "
+10 IF '$DATA(^AUPNPAT("AQ1"))
WRITE "not "
+11 WRITE "present",!
+12 WRITE ?3,"V IMMUNIZATION 'AQ' index is "
+13 IF '$DATA(^AUPNVIMM("AQ"))
WRITE "not "
+14 WRITE "present",!
+15 WRITE ?3,"V LAB 'AQ' index is "
+16 IF '$DATA(^AUPNVLAB("AQ"))
WRITE "not "
+17 WRITE "present",!
+18 WRITE ?3,"V MEASUREMENT 'AQ' index is "
+19 IF '$DATA(^AUPNVMSR("AQ"))
WRITE "not "
+20 WRITE "present",!
+21 WRITE ?3,"V SKIN TEST 'AQ' index is "
+22 IF '$DATA(^AUPNVSK("AQ"))
WRITE "not "
+23 WRITE "present",!
+24 WRITE !!!
+25 SET DIR(0)="E"
+26 DO ^DIR
+27 KILL DIRUT,DUOUT,DTOUT,DIR
EXIT KILL %Y
+1 QUIT
+2 ;
NEW WRITE !!,"Q-Man indices have not been activated!",!!
+1 WRITE "I can create the Q-Man indices now. This will significantly improve the",!
+2 WRITE "performance of Q-Man and reduce stress on the CPU. However, the new indices",!
+3 WRITE "will increase the size of the PCC database by approximately 1%"
+4 WRITE !!,"Want me to create the indices?"
+5 SET %=0
+6 DO YN^DICN
+7 KILL DIR,%
+8 IF $EXTRACT(%Y)=U!("Yy"'[%Y)!(%Y="")!($DATA(DUOUT))!($DATA(DTOUT))
KILL DUOUT,DTOUT,%Y
QUIT
+9 WRITE !,"OK, I'll run the job in background. This job will take 1-72 hours to complete.",!!
MAILTASK SET ZTRTN="JOB^AMQQMGR1"
+1 SET ZTDTH="NOW"
+2 SET ZTIO=""
+3 SET ZTDESC="CREATE Q-MAN INDICES"
+4 DO ^%ZTLOAD
+5 WRITE !!,$SELECT($DATA(ZTSK):"Request queued!",1:"Request cancelled!"),!!!
+6 HANG 3
+7 QUIT
+8 ;
JOB ;
+1 SET G=U_"AUTTSITE"
+2 SET $PIECE(@G@(1,0),U,19)="Y"
+3 KILL G,AMQQAQF
+4 IF $PIECE($GET(^AUTTSITE(1,0)),U,19)'="Y"
QUIT
+5 ;
VIMM ; re-indexing v immunization
+1 KILL ^AUPNVIMM("AQ")
+2 SET DIK="^AUPNVIMM("
+3 SET DIK(1)=".01^AQTOO"
+4 DO ENALL^DIK
+5 KILL DIK
+6 ;
PAT ; re-indexing aq1 on Patient
+1 KILL AUPNPAT("AQ1")
+2 FOR DA=0:0
SET DA=$ORDER(^AUPNPAT(DA))
IF 'DA
QUIT
SET X=$PIECE($GET(^(DA,11)),U,10)
KILL AMQQQXR
DO QXR
IF $DATA(AMQQQXR)
SET ^AUPNPAT("AQ1",AMQQQXR,DA)=""
+3 ;
VMSR ; re-indexing aq on v measurement
+1 KILL ^AUPNVMSR("AQ")
+2 FOR DA=0:0
SET DA=$ORDER(^AUPNVMSR(DA))
IF 'DA
QUIT
SET AUPNCIXF="S"
SET AUPNCIXV=$GET(^(DA,0))
SET X=$PIECE(AUPNCIXV,U,4)
IF X'=""
DO VMSR04^AUPNCIX
+3 ;
VDXP ; Re-indexing AQ on V DIAGNOSTIC PROCEDURE RESULT
+1 KILL ^AUPNVDXP("AQ")
+2 SET AMQQX=0
+3 FOR
SET AMQQX=$ORDER(^AUPNVDXP(AMQQX))
IF AMQQX'=+AMQQX
QUIT
IF $DATA(^AUPNVDXP(AMQQX,0))
SET DA=AMQQX
SET X=$PIECE(^AUPNVDXP(AMQQX,0),U,1)
SET AUPNDXQF="S1"
DO ^AUPNVDXP
+4 ;
VXAM ;re-index AQ on V exam
+1 KILL ^AUPNVXAM("AQ")
+2 SET AMQQX=0
+3 FOR
SET AMQQX=$ORDER(^AUPNVXAM(AMQQX))
IF AMQQX'=+AMQQX
QUIT
IF $DATA(^AUPNVXAM(AMQQX,0))
SET DA=AMQQX
SET X=$PIECE(^AUPNVXAM(AMQQX,0),U,1)
DO AQE1^AUPNCIXL
+4 KILL ^AUPNVNTS("AQ")
+5 SET AMQQX=0
+6 FOR
SET AMQQX=$ORDER(^AUPNVNTS(AMQQX))
IF AMQQX'=+AMQQX
QUIT
IF $DATA(^AUPNVNTS(AMQQX,0))
SET DA=AMQQX
SET X=$PIECE(^AUPNVNTS(AMQQX,0),U,1)
DO AQE1^AUPNCIXL
+7 ;
VSK ;re-index aq on v skin test
+1 KILL ^AUPNVSK("AQ")
+2 SET AMQQX=0
+3 FOR
SET AMQQX=$ORDER(^AUPNVSK(AMQQX))
IF AMQQX'=+AMQQX
QUIT
IF $DATA(^AUPNVSK(AMQQX,0))
SET DA=AMQQX
SET X=$PIECE(^AUPNVSK(AMQQX,0),U,1)
DO AQS1^AUPNCIXL
+4 ;
VRAD ; re-index aq on v radiology
+1 KILL ^AUPNVRAD("AQ")
+2 SET AMQQX=0
+3 FOR
SET AMQQX=$ORDER(^AUPNVRAD(AMQQX))
IF AMQQX'=+AMQQX
QUIT
IF $DATA(^AUPNVRAD(AMQQX,0))
SET DA=AMQQX
SET X=$PIECE(^AUPNVRAD(AMQQX,0),U,1)
DO AQR1^AUPNCIXL
+4 ;
VLAB ; re-index aq on v lab
+1 KILL ^AUPNVLAB("AQ")
+2 SET AMQQX=0
+3 FOR
SET AMQQX=$ORDER(^AUPNVLAB(AMQQX))
IF AMQQX'=+AMQQX
QUIT
IF $DATA(^AUPNVLAB(AMQQX,0))
SET DA=AMQQX
SET X=$PIECE(^AUPNVLAB(AMQQX,0),U,1)
DO AQ1^AUPNCIXL
+4 ;
KILL KILL AMQQX,DA,DIE,DIK,AUPNDXQF
+1 QUIT
+2 ;
QXR ; ENTRY POINT
+1 IF X=""
QUIT
+2 NEW %
+3 SET %=X
+4 NEW X
+5 IF %["/"
SET %=(+%/$SELECT($PIECE(%,"/",2):$PIECE(%,"/",2),1:1))
IF $EXTRACT(%)="."
SET %=0_%
SET AMQQQXR=$EXTRACT(%,1,5)+1
IF '$DATA(AMQQQXR)
SET AMQQQXR=%+1
QUIT
+6 SET %=$SELECT($EXTRACT(%)="F":2,$EXTRACT(%)="N":1,$EXTRACT(%,1,3)="UNK":2.1,$EXTRACT(%,1,3)="UNS":2.2,1:"")
+7 IF %'=""
SET AMQQQXR=%
+8 QUIT
+9 ;
