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

AMQQCMP0.m

Go to the documentation of this file. 
  1. AMQQCMP0 ;IHS/CMI/THL - MAKES SEARCH TEMPLATES ;
  1.  ;;2.0;IHS PCC SUITE;**2**;MAY 14, 2009
  1.  ; CALLS TASKMAN
  1.  ;-----
  1. RUN D COHORT
  1. EXIT K AMQQFILE,AMQQBACK,%,%Y,I,K,T,X1,X2,XY
  1.  Q
  1.  ;
  1. COHORT K AMQQFILE
  1.  D FILE
  1.  I $D(AMQQQUIT)!('$D(AMQQFILE)) Q
  1. COH1 W !
  1.  S DIC("A")="Enter the name of the SEARCH TEMPLATE: "
  1.  S DIC="^DIBT("
  1.  S DLAYGO=0
  1.  S DIC(0)="AEQL"
  1.  S DIC("S")="I $P(^(0),U,4)=AMQQFILE"
  1.  D ^DIC
  1.  I Y=-1,X=U S AMQQQUIT="" Q
  1.  I Y=-1 W !,"Cohort not saved...",!! K AMQQCHRT Q
  1.  I '$P(Y,U,3) D CHECK G:Y=-1 COH1 D COVER Q:$D(AMQQQUIT)  I Y=-1 G COH1
  1. COSET K AMQQDIBS
  1.  S AMQQDIBT=+Y
  1.  S DA=AMQQDIBT
  1.  S DIE="^DIBT("
  1.  S DR="2////"_DT_";3////"_DUZ(0)_";4////"_AMQQFILE_";5////"_DUZ_";10"
  1.  D ^DIE
  1.  K DIE,DA,DR,DIC
  1.  S AMQQH1=$H
  1.  K AMQQBACK
  1.  W !!,"Next, you will be asked about creating your template in background..." D TASKHELP  ;CMI/GRL
  1.  D BACK
  1.  I $D(AMQQBACK) Q
  1.  I $D(AMQQQUIT) Q
  1.  S (IOP,AMQQIOP)=0
  1.  D ^%ZIS
  1.  I $E(IOST,1,2)'="P-" W !! D WAIT^DICD
  1.  X AMQV(0)
  1.  D DIBT
  1.  Q
  1.  ;
  1. CHECK ;Check to see if user storing results in a template used in this search
  1.  N AMQQCNT
  1.  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
  1.  Q
  1.  ;
  1. COVER S AMQQDIBS=Y
  1.  W !!,"The "_$P(Y,U,2)_" cohort already exists.  Want to overwrite"
  1.  S %=2
  1.  D YN^DICN
  1.  S:$D(DTOUT) %Y=U
  1.  K DTOUT
  1.  I %Y=U S AMQQQUIT="" Q
  1.  I "Nn"[$E(%Y) S Y=-1 Q
  1.  I $P(^DIBT(+Y,0),U,5)=DUZ G COVX
  1.  W !!,"Whoops...I just realized you did not create this template, and therefore you",!
  1.  W "are not allowed to overwrite it. (You wouldn't want to destroy someone else's",!
  1.  W "data, would you???)  Try again with a new template name.",!,*7
  1.  S Y=-1
  1.  Q
  1. COVX S DIK="^DIBT("
  1.  S DA=+AMQQDIBS
  1.  D ^DIK
  1.  S DIC=DIK
  1.  S DIC(0)="L"
  1.  S DIADD=1
  1.  S DINUM=+AMQQDIBS
  1.  S X=$P(AMQQDIBS,U,2)
  1.  D ^DIC
  1.  K DIC,DIADD,AMQQDIBS
  1.  S AMQQSAVY=Y
  1.  S DR=".01"
  1.  S DIE="^DIBT("
  1.  S DA=+Y
  1.  D ^DIE
  1.  K DA,DIE,DR
  1.  S Y=AMQQSAVY
  1.  K AMQQSAVY
  1.  I '$D(^DIBT(+Y,0)) S Y=-1
  1.  Q
  1.  ;
  1. FILE I AMQQCCLS="V" S AMQQFILE=9000010
  1.  E  I AMQQCCLS="H" S AMQQFILE=6
  1.  E  S AMQQFILE=9000001
  1.  W !!,"Fileman users please note =>"
  1.  W !,"This template will be attached to IHS' ",$S(AMQQFILE=9000001:"PATIENT file (#9000001)",AMQQFILE=9000010:"VISIT file (#9000010)",1:"PROVIDER file (#6)"),!!
  1.  I AMQQFILE=6 W "=> This template can only be used within File Manager.",!
  1.  Q
  1.  ;
  1. DIBT W !!!,"Search template completed...",*7
  1.  W !!,"This query generates ",AMQQTOT," ""hits""",!
  1.  S AMQQH2=$H
  1.  S X1=AMQQH1
  1.  S X2=AMQQH2
  1.  D ELT
  1.  W "Time required to create search template: ",X,!!
  1.  I '$D(ZTQUEUED) R !,"<>",X:DTIME
  1.  I AMQQFILE=9000001 D
  1.  .K DIR,X,Y
  1.  .S DIR(0)="S^P:Go to PGEN;V:Go to VGEN;Q:Continue with Qman"
  1.  .S DIR("A")="Enter your choice"
  1.  .S DIR("B")="Q"
  1.  .S DIR("?")="Type P, V or Q and press enter"
  1.  D ^DIR
  1.  K DIR
  1.  S:$D(DUOUT) DIRUT=1
  1.  Q:Y="Q"  ;PATCH XXX
  1.  I Y="P" D  G ORDER^APCLVL
  1.  .W !!,"OK ... I'll take you to the PGEN Outputs screen",!
  1.  .D HELP
  1.  .S APCLSEAT=AMQQDIBT
  1.  .S APCLPCNT=0
  1.  .S APCLPTCT=0
  1.  .S APCLPTVS="P"
  1.  .S APCLTYPE="PS"
  1.  I Y="V" D  G ORDER^APCLVL
  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",!
  1.  .D HELP
  1.  .S APCLSEAT=AMQQDIBT
  1.  .S APCLPCNT=0
  1.  .S APCLPTCT=0
  1.  .S APCLPTVS="V"
  1.  .S APCLTYPE="VP"
  1.  I AMQQFILE=9000010 D  G:Y=1 BD^APCLVL ;PATCH XXX
  1.  .K DIR
  1.  .S DIR(0)="Y"
  1.  .S DIR("A")="Do you want to go to VGEN"
  1.  .D ^DIR
  1.  .K DIR
  1.  .Q:Y'=1
  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",!
  1.  .D HELP
  1.  .S APCLSEAT=AMQQDIBT
  1.  .S APCLPCNT=0
  1.  .S APCLPTCT=0
  1.  .S APCLPTVS="V"
  1.  .S APCLTYPE="VV"
  1.  ;
  1.  K AMQQH1,AMQQH2,AMQQDIBT
  1.  Q
  1. HELP ;PGEN/VGEN HELP
  1.  K DIR
  1.  S DIR(0)="E"
  1.  S DIR("A")="Press ENTER to continue or '^' to quit"
  1.  D ^DIR
  1.  Q
  1.  ;
  1. MAIL ;SEND MAIL MESSAGES TO USERS RE:TEMPLATES
  1.  S XMDUZ=.5
  1.  S XMTEXT="AMQQMAIL("
  1.  S XMSUB="*** NOTICE OF QMAN SEARCH TEMPLATE COMPLETION ***"
  1.  S AMQQMAIL(1,0)="THE SEARCH TEMPLATE "_$P(^DIBT(AMQQDIBT,0),U)_" IS NOW READY FOR USE"
  1.  S XMY(DUZ)=""
  1.  D ^XMD
  1.  K AMQQMAIL
  1.  Q
  1.  ;
  1. ELT ; ENTRY POINT FROM AMQQCMPP
  1.  S X=(((+X2)-(+X1))*86400)+$P(X2,",",2)-$P(X1,",",2)
  1.  S %=""
  1.  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)
  1.  S %=%_X_" SECOND"
  1.  I X'=1 S %=%_"S"
  1.  S X=%
  1.  Q
  1.  ;
  1. BACK W !!,"Want to run this task in background"
  1.  S %=2
  1.  D YN^DICN
  1.  S %Y=$S(%=2:"N",%=1:"Y",%=0:"?",%=-1:"^",1:0)
  1.  I $D(DTOUT) S %Y=U K DTOUT
  1.  I $E(%Y)=U S AMQQQUIT="" Q
  1.  I "nN"[%Y Q
  1.  ;I $E(%Y)="?" W !!,?5,"ANSWER 'YES' or 'NO'",! G BACK
  1.  I $E(%Y)="?" D TASKHELP G BACK  ;IHS/CMI/GRL
  1. ZT S AMQQBACK=""
  1.  S ZTRTN="TASK^AMQQCMP0"
  1.  S ZTIO=""
  1.  S ZTDTH="NOW"
  1.  S ZTDESC="QUERY UTILITY GENERATING SEARCH TEMPLATE "
  1.  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(%)=""
  1.  D ^%ZTLOAD
  1.  D ^%ZISC
  1.  W !!,$S($D(ZTSK):"Search template being generated in background",1:"Background job cancelled due to technical problems"),!!!
  1.  H 3
  1.  Q
  1.  ;
  1. TASK X AMQV(1)
  1.  F I=1:1 S %=$P("AMQQ^AMQQ TAX^AMQQ TEMP^AMQQ SER1^AMQQ SAVE",U,I) Q:%=""  K ^UTILITY(%,$J)
  1.  I $D(ZTQUEUED) S ZTREQ="@"
  1.  D MAIL
  1.  Q
  1.  ;
  1. TASKHELP ;
  1.  W !!,"Answer 'YES' to run in background."
  1.  W !!,"To run in background means to pass the template creation job off to Taskman."
  1.  W !,"Your terminal will be released so additional RPMS work may be performed while"
  1.  W !,"the template is being created.  When finished, Taskman will send you a Mailman"
  1.  W !,"message indicating that the job is ready.  Then, you may use the template in"
  1.  W !,"future Qman searches, PGEN, VGEN and other reports that can utilize templates."
  1.  W !
  1.  W !,"Answer 'NO', to create the search template in foreground."
  1.  W !!,"While the template is being created, data will be displayed to your screen."
  1.  W !,"When the job has finished, you will have the opportunity to go to PGEN or VGEN."
  1.  W !,"Remember ... some templates may take a very long time to finish."
  1.  W !
  1.  D HELP
  1.  Q