AMQQCMP0 ;IHS/CMI/THL - MAKES SEARCH TEMPLATES ;
;;2.0;IHS PCC SUITE;**2**;MAY 14, 2009
; CALLS TASKMAN
;-----
RUN D COHORT
EXIT K AMQQFILE,AMQQBACK,%,%Y,I,K,T,X1,X2,XY
Q
;
COHORT K AMQQFILE
D FILE
I $D(AMQQQUIT)!('$D(AMQQFILE)) Q
COH1 W !
S DIC("A")="Enter the name of the SEARCH TEMPLATE: "
S DIC="^DIBT("
S DLAYGO=0
S DIC(0)="AEQL"
S DIC("S")="I $P(^(0),U,4)=AMQQFILE"
D ^DIC
I Y=-1,X=U S AMQQQUIT="" Q
I Y=-1 W !,"Cohort not saved...",!! K AMQQCHRT Q
I '$P(Y,U,3) D CHECK G:Y=-1 COH1 D COVER Q:$D(AMQQQUIT) I Y=-1 G COH1
COSET K AMQQDIBS
S AMQQDIBT=+Y
S DA=AMQQDIBT
S DIE="^DIBT("
S DR="2////"_DT_";3////"_DUZ(0)_";4////"_AMQQFILE_";5////"_DUZ_";10"
D ^DIE
K DIE,DA,DR,DIC
S AMQQH1=$H
K AMQQBACK
W !!,"Next, you will be asked about creating your template in background..." D TASKHELP ;CMI/GRL
D BACK
I $D(AMQQBACK) Q
I $D(AMQQQUIT) Q
S (IOP,AMQQIOP)=0
D ^%ZIS
I $E(IOST,1,2)'="P-" W !! D WAIT^DICD
X AMQV(0)
D DIBT
Q
;
CHECK ;Check to see if user storing results in a template used in this search
N AMQQCNT
F AMQQCNT=0:1 Q:'$D(AMQV(AMQQCNT))!(Y=-1) I AMQV(AMQQCNT)[("DIBT("_+Y) W !,*7,"You cannot save results in a search template currently in use by your search!",!,"Please select a different search template." S Y=-1
Q
;
COVER S AMQQDIBS=Y
W !!,"The "_$P(Y,U,2)_" cohort already exists. Want to overwrite"
S %=2
D YN^DICN
S:$D(DTOUT) %Y=U
K DTOUT
I %Y=U S AMQQQUIT="" Q
I "Nn"[$E(%Y) S Y=-1 Q
I $P(^DIBT(+Y,0),U,5)=DUZ G COVX
W !!,"Whoops...I just realized you did not create this template, and therefore you",!
W "are not allowed to overwrite it. (You wouldn't want to destroy someone else's",!
W "data, would you???) Try again with a new template name.",!,*7
S Y=-1
Q
COVX S DIK="^DIBT("
S DA=+AMQQDIBS
D ^DIK
S DIC=DIK
S DIC(0)="L"
S DIADD=1
S DINUM=+AMQQDIBS
S X=$P(AMQQDIBS,U,2)
D ^DIC
K DIC,DIADD,AMQQDIBS
S AMQQSAVY=Y
S DR=".01"
S DIE="^DIBT("
S DA=+Y
D ^DIE
K DA,DIE,DR
S Y=AMQQSAVY
K AMQQSAVY
I '$D(^DIBT(+Y,0)) S Y=-1
Q
;
FILE I AMQQCCLS="V" S AMQQFILE=9000010
E I AMQQCCLS="H" S AMQQFILE=6
E S AMQQFILE=9000001
W !!,"Fileman users please note =>"
W !,"This template will be attached to IHS' ",$S(AMQQFILE=9000001:"PATIENT file (#9000001)",AMQQFILE=9000010:"VISIT file (#9000010)",1:"PROVIDER file (#6)"),!!
I AMQQFILE=6 W "=> This template can only be used within File Manager.",!
Q
;
DIBT W !!!,"Search template completed...",*7
W !!,"This query generates ",AMQQTOT," ""hits""",!
S AMQQH2=$H
S X1=AMQQH1
S X2=AMQQH2
D ELT
W "Time required to create search template: ",X,!!
I '$D(ZTQUEUED) R !,"<>",X:DTIME
I AMQQFILE=9000001 D
.K DIR,X,Y
.S DIR(0)="S^P:Go to PGEN;V:Go to VGEN;Q:Continue with Qman"
.S DIR("A")="Enter your choice"
.S DIR("B")="Q"
.S DIR("?")="Type P, V or Q and press enter"
D ^DIR
K DIR
S:$D(DUOUT) DIRUT=1
Q:Y="Q" ;PATCH XXX
I Y="P" D G ORDER^APCLVL
.W !!,"OK ... I'll take you to the PGEN Outputs screen",!
.D HELP
.S APCLSEAT=AMQQDIBT
.S APCLPCNT=0
.S APCLPTCT=0
.S APCLPTVS="P"
.S APCLTYPE="PS"
I Y="V" D G ORDER^APCLVL
.W !!,"OK ... I'll take you to VGEN where you will reenter a date range, then select additional Visit data items, or go on to the VGEN Outputs screen",!
.D HELP
.S APCLSEAT=AMQQDIBT
.S APCLPCNT=0
.S APCLPTCT=0
.S APCLPTVS="V"
.S APCLTYPE="VP"
I AMQQFILE=9000010 D G:Y=1 BD^APCLVL ;PATCH XXX
.K DIR
.S DIR(0)="Y"
.S DIR("A")="Do you want to go to VGEN"
.D ^DIR
.K DIR
.Q:Y'=1
.W !!,"OK ... I'll take you to VGEN where you will reenter a date range, then select additional Visit data items, or go on to the VGEN Outputs screen",!
.D HELP
.S APCLSEAT=AMQQDIBT
.S APCLPCNT=0
.S APCLPTCT=0
.S APCLPTVS="V"
.S APCLTYPE="VV"
;
K AMQQH1,AMQQH2,AMQQDIBT
Q
HELP ;PGEN/VGEN HELP
K DIR
S DIR(0)="E"
S DIR("A")="Press ENTER to continue or '^' to quit"
D ^DIR
Q
;
MAIL ;SEND MAIL MESSAGES TO USERS RE:TEMPLATES
S XMDUZ=.5
S XMTEXT="AMQQMAIL("
S XMSUB="*** NOTICE OF QMAN SEARCH TEMPLATE COMPLETION ***"
S AMQQMAIL(1,0)="THE SEARCH TEMPLATE "_$P(^DIBT(AMQQDIBT,0),U)_" IS NOW READY FOR USE"
S XMY(DUZ)=""
D ^XMD
K AMQQMAIL
Q
;
ELT ; ENTRY POINT FROM AMQQCMPP
S X=(((+X2)-(+X1))*86400)+$P(X2,",",2)-$P(X1,",",2)
S %=""
F I=1:1:3 S K=$P("86400^3600^60",U,I),T=$P("DAY^HOUR^MINUTE",U,I),Y=X\K I Y S %=%_Y_" "_T_$S(Y>1:"S, ",1:", "),X=X-(K*Y)
S %=%_X_" SECOND"
I X'=1 S %=%_"S"
S X=%
Q
;
BACK W !!,"Want to run this task in background"
S %=2
D YN^DICN
S %Y=$S(%=2:"N",%=1:"Y",%=0:"?",%=-1:"^",1:0)
I $D(DTOUT) S %Y=U K DTOUT
I $E(%Y)=U S AMQQQUIT="" Q
I "nN"[%Y Q
;I $E(%Y)="?" W !!,?5,"ANSWER 'YES' or 'NO'",! G BACK
I $E(%Y)="?" D TASKHELP G BACK ;IHS/CMI/GRL
ZT S AMQQBACK=""
S ZTRTN="TASK^AMQQCMP0"
S ZTIO=""
S ZTDTH="NOW"
S ZTDESC="QUERY UTILITY GENERATING SEARCH TEMPLATE "
F I=1:1 S %=$P("DT;AMQQ200(;AMQQBACK;AMQQDIBT;DTIME;DUZ(;DUZ;U;AMQV(;AMQQCCLS;^UTILITY(""AMQQ"",$J,""VAR NAME"",;^UTILITY(""AMQQ RAND"",$J,;^UTILITY(""AMQQ TAX"",$J,",";",I) Q:%="" S ZTSAVE(%)=""
D ^%ZTLOAD
D ^%ZISC
W !!,$S($D(ZTSK):"Search template being generated in background",1:"Background job cancelled due to technical problems"),!!!
H 3
Q
;
TASK X AMQV(1)
F I=1:1 S %=$P("AMQQ^AMQQ TAX^AMQQ TEMP^AMQQ SER1^AMQQ SAVE",U,I) Q:%="" K ^UTILITY(%,$J)
I $D(ZTQUEUED) S ZTREQ="@"
D MAIL
Q
;
TASKHELP ;
W !!,"Answer 'YES' to run in background."
W !!,"To run in background means to pass the template creation job off to Taskman."
W !,"Your terminal will be released so additional RPMS work may be performed while"
W !,"the template is being created. When finished, Taskman will send you a Mailman"
W !,"message indicating that the job is ready. Then, you may use the template in"
W !,"future Qman searches, PGEN, VGEN and other reports that can utilize templates."
W !
W !,"Answer 'NO', to create the search template in foreground."
W !!,"While the template is being created, data will be displayed to your screen."
W !,"When the job has finished, you will have the opportunity to go to PGEN or VGEN."
W !,"Remember ... some templates may take a very long time to finish."
W !
D HELP
Q
AMQQCMP0 ;IHS/CMI/THL - MAKES SEARCH TEMPLATES ;
+1 ;;2.0;IHS PCC SUITE;**2**;MAY 14, 2009
+2 ; CALLS TASKMAN
+3 ;-----
RUN DO COHORT
EXIT KILL AMQQFILE,AMQQBACK,%,%Y,I,K,T,X1,X2,XY
+1 QUIT
+2 ;
COHORT KILL AMQQFILE
+1 DO FILE
+2 IF $DATA(AMQQQUIT)!('$DATA(AMQQFILE))
QUIT
COH1 WRITE !
+1 SET DIC("A")="Enter the name of the SEARCH TEMPLATE: "
+2 SET DIC="^DIBT("
+3 SET DLAYGO=0
+4 SET DIC(0)="AEQL"
+5 SET DIC("S")="I $P(^(0),U,4)=AMQQFILE"
+6 DO ^DIC
+7 IF Y=-1
IF X=U
SET AMQQQUIT=""
QUIT
+8 IF Y=-1
WRITE !,"Cohort not saved...",!!
KILL AMQQCHRT
QUIT
+9 IF '$PIECE(Y,U,3)
DO CHECK
IF Y=-1
GOTO COH1
DO COVER
IF $DATA(AMQQQUIT)
QUIT
IF Y=-1
GOTO COH1
COSET KILL AMQQDIBS
+1 SET AMQQDIBT=+Y
+2 SET DA=AMQQDIBT
+3 SET DIE="^DIBT("
+4 SET DR="2////"_DT_";3////"_DUZ(0)_";4////"_AMQQFILE_";5////"_DUZ_";10"
+5 DO ^DIE
+6 KILL DIE,DA,DR,DIC
+7 SET AMQQH1=$HOROLOG
+8 KILL AMQQBACK
+9 ;CMI/GRL
WRITE !!,"Next, you will be asked about creating your template in background..."
DO TASKHELP
+10 DO BACK
+11 IF $DATA(AMQQBACK)
QUIT
+12 IF $DATA(AMQQQUIT)
QUIT
+13 SET (IOP,AMQQIOP)=0
+14 DO ^%ZIS
+15 IF $EXTRACT(IOST,1,2)'="P-"
WRITE !!
DO WAIT^DICD
+16 XECUTE AMQV(0)
+17 DO DIBT
+18 QUIT
+19 ;
CHECK ;Check to see if user storing results in a template used in this search
+1 NEW AMQQCNT
+2 FOR AMQQCNT=0:1
IF '$DATA(AMQV(AMQQCNT))!(Y=-1)
QUIT
IF AMQV(AMQQCNT)[("DIBT("_+Y)
WRITE !,*7,"You cannot save results in a search template currently in use by your search!",!,"Please select a different search template."
SET Y=-1
+3 QUIT
+4 ;
COVER SET AMQQDIBS=Y
+1 WRITE !!,"The "_$PIECE(Y,U,2)_" cohort already exists. Want to overwrite"
+2 SET %=2
+3 DO YN^DICN
+4 IF $DATA(DTOUT)
SET %Y=U
+5 KILL DTOUT
+6 IF %Y=U
SET AMQQQUIT=""
QUIT
+7 IF "Nn"[$EXTRACT(%Y)
SET Y=-1
QUIT
+8 IF $PIECE(^DIBT(+Y,0),U,5)=DUZ
GOTO COVX
+9 WRITE !!,"Whoops...I just realized you did not create this template, and therefore you",!
+10 WRITE "are not allowed to overwrite it. (You wouldn't want to destroy someone else's",!
+11 WRITE "data, would you???) Try again with a new template name.",!,*7
+12 SET Y=-1
+13 QUIT
COVX SET DIK="^DIBT("
+1 SET DA=+AMQQDIBS
+2 DO ^DIK
+3 SET DIC=DIK
+4 SET DIC(0)="L"
+5 SET DIADD=1
+6 SET DINUM=+AMQQDIBS
+7 SET X=$PIECE(AMQQDIBS,U,2)
+8 DO ^DIC
+9 KILL DIC,DIADD,AMQQDIBS
+10 SET AMQQSAVY=Y
+11 SET DR=".01"
+12 SET DIE="^DIBT("
+13 SET DA=+Y
+14 DO ^DIE
+15 KILL DA,DIE,DR
+16 SET Y=AMQQSAVY
+17 KILL AMQQSAVY
+18 IF '$DATA(^DIBT(+Y,0))
SET Y=-1
+19 QUIT
+20 ;
FILE IF AMQQCCLS="V"
SET AMQQFILE=9000010
+1 IF '$TEST
IF AMQQCCLS="H"
SET AMQQFILE=6
+2 IF '$TEST
SET AMQQFILE=9000001
+3 WRITE !!,"Fileman users please note =>"
+4 WRITE !,"This template will be attached to IHS' ",$SELECT(AMQQFILE=9000001:"PATIENT file (#9000001)",AMQQFILE=9000010:"VISIT file (#9000010)",1:"PROVIDER file (#6)"),!!
+5 IF AMQQFILE=6
WRITE "=> This template can only be used within File Manager.",!
+6 QUIT
+7 ;
DIBT WRITE !!!,"Search template completed...",*7
+1 WRITE !!,"This query generates ",AMQQTOT," ""hits""",!
+2 SET AMQQH2=$HOROLOG
+3 SET X1=AMQQH1
+4 SET X2=AMQQH2
+5 DO ELT
+6 WRITE "Time required to create search template: ",X,!!
+7 IF '$DATA(ZTQUEUED)
READ !,"<>",X:DTIME
+8 IF AMQQFILE=9000001
Begin DoDot:1
+9 KILL DIR,X,Y
+10 SET DIR(0)="S^P:Go to PGEN;V:Go to VGEN;Q:Continue with Qman"
+11 SET DIR("A")="Enter your choice"
+12 SET DIR("B")="Q"
+13 SET DIR("?")="Type P, V or Q and press enter"
End DoDot:1
+14 DO ^DIR
+15 KILL DIR
+16 IF $DATA(DUOUT)
SET DIRUT=1
+17 ;PATCH XXX
IF Y="Q"
QUIT
+18 IF Y="P"
Begin DoDot:1
+19 WRITE !!,"OK ... I'll take you to the PGEN Outputs screen",!
+20 DO HELP
+21 SET APCLSEAT=AMQQDIBT
+22 SET APCLPCNT=0
+23 SET APCLPTCT=0
+24 SET APCLPTVS="P"
+25 SET APCLTYPE="PS"
End DoDot:1
GOTO ORDER^APCLVL
+26 IF Y="V"
Begin DoDot:1
+27 WRITE !!,"OK ... I'll take you to VGEN where you will reenter a date range, then select additional Visit data items, or go on to the VGEN Outputs screen",!
+28 DO HELP
+29 SET APCLSEAT=AMQQDIBT
+30 SET APCLPCNT=0
+31 SET APCLPTCT=0
+32 SET APCLPTVS="V"
+33 SET APCLTYPE="VP"
End DoDot:1
GOTO ORDER^APCLVL
+34 ;PATCH XXX
IF AMQQFILE=9000010
Begin DoDot:1
+35 KILL DIR
+36 SET DIR(0)="Y"
+37 SET DIR("A")="Do you want to go to VGEN"
+38 DO ^DIR
+39 KILL DIR
+40 IF Y'=1
QUIT
+41 WRITE !!,"OK ... I'll take you to VGEN where you will reenter a date range, then select additional Visit data items, or go on to the VGEN Outputs screen",!
+42 DO HELP
+43 SET APCLSEAT=AMQQDIBT
+44 SET APCLPCNT=0
+45 SET APCLPTCT=0
+46 SET APCLPTVS="V"
+47 SET APCLTYPE="VV"
End DoDot:1
IF Y=1
GOTO BD^APCLVL
+48 ;
+49 KILL AMQQH1,AMQQH2,AMQQDIBT
+50 QUIT
HELP ;PGEN/VGEN HELP
+1 KILL DIR
+2 SET DIR(0)="E"
+3 SET DIR("A")="Press ENTER to continue or '^' to quit"
+4 DO ^DIR
+5 QUIT
+6 ;
MAIL ;SEND MAIL MESSAGES TO USERS RE:TEMPLATES
+1 SET XMDUZ=.5
+2 SET XMTEXT="AMQQMAIL("
+3 SET XMSUB="*** NOTICE OF QMAN SEARCH TEMPLATE COMPLETION ***"
+4 SET AMQQMAIL(1,0)="THE SEARCH TEMPLATE "_$PIECE(^DIBT(AMQQDIBT,0),U)_" IS NOW READY FOR USE"
+5 SET XMY(DUZ)=""
+6 DO ^XMD
+7 KILL AMQQMAIL
+8 QUIT
+9 ;
ELT ; ENTRY POINT FROM AMQQCMPP
+1 SET X=(((+X2)-(+X1))*86400)+$PIECE(X2,",",2)-$PIECE(X1,",",2)
+2 SET %=""
+3 FOR I=1:1:3
SET K=$PIECE("86400^3600^60",U,I)
SET T=$PIECE("DAY^HOUR^MINUTE",U,I)
SET Y=X\K
IF Y
SET %=%_Y_" "_T_$SELECT(Y>1:"S, ",1:", ")
SET X=X-(K*Y)
+4 SET %=%_X_" SECOND"
+5 IF X'=1
SET %=%_"S"
+6 SET X=%
+7 QUIT
+8 ;
BACK WRITE !!,"Want to run this task in background"
+1 SET %=2
+2 DO YN^DICN
+3 SET %Y=$SELECT(%=2:"N",%=1:"Y",%=0:"?",%=-1:"^",1:0)
+4 IF $DATA(DTOUT)
SET %Y=U
KILL DTOUT
+5 IF $EXTRACT(%Y)=U
SET AMQQQUIT=""
QUIT
+6 IF "nN"[%Y
QUIT
+7 ;I $E(%Y)="?" W !!,?5,"ANSWER 'YES' or 'NO'",! G BACK
+8 ;IHS/CMI/GRL
IF $EXTRACT(%Y)="?"
DO TASKHELP
GOTO BACK
ZT SET AMQQBACK=""
+1 SET ZTRTN="TASK^AMQQCMP0"
+2 SET ZTIO=""
+3 SET ZTDTH="NOW"
+4 SET ZTDESC="QUERY UTILITY GENERATING SEARCH TEMPLATE "
+5 FOR I=1:1
SET %=$PIECE("DT;AMQQ200(;AMQQBACK;AMQQDIBT;DTIME;DUZ(;DUZ;U;AMQV(;AMQQCCLS;^UTILITY(""AMQQ"",$J,""VAR NAME"",;^UTILITY(""AMQQ RAND"",$J,;^UTILITY(""AMQQ TAX"",$J,",";",I)
IF %=""
QUIT
SET ZTSAVE(%)=""
+6 DO ^%ZTLOAD
+7 DO ^%ZISC
+8 WRITE !!,$SELECT($DATA(ZTSK):"Search template being generated in background",1:"Background job cancelled due to technical problems"),!!!
+9 HANG 3
+10 QUIT
+11 ;
TASK XECUTE AMQV(1)
+1 FOR I=1:1
SET %=$PIECE("AMQQ^AMQQ TAX^AMQQ TEMP^AMQQ SER1^AMQQ SAVE",U,I)
IF %=""
QUIT
KILL ^UTILITY(%,$JOB)
+2 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+3 DO MAIL
+4 QUIT
+5 ;
TASKHELP ;
+1 WRITE !!,"Answer 'YES' to run in background."
+2 WRITE !!,"To run in background means to pass the template creation job off to Taskman."
+3 WRITE !,"Your terminal will be released so additional RPMS work may be performed while"
+4 WRITE !,"the template is being created. When finished, Taskman will send you a Mailman"
+5 WRITE !,"message indicating that the job is ready. Then, you may use the template in"
+6 WRITE !,"future Qman searches, PGEN, VGEN and other reports that can utilize templates."
+7 WRITE !
+8 WRITE !,"Answer 'NO', to create the search template in foreground."
+9 WRITE !!,"While the template is being created, data will be displayed to your screen."
+10 WRITE !,"When the job has finished, you will have the opportunity to go to PGEN or VGEN."
+11 WRITE !,"Remember ... some templates may take a very long time to finish."
+12 WRITE !
+13 DO HELP
+14 QUIT