- 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 ;
