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

ACDRL0.m

Go to the documentation of this file.
  1. ACDRL0 ;IHS/ADC/EDE/KML - SCREEN LOGIC;
  1. ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
  1. ;
  1. ;
  1. Q ;EP
  1. K DIC,DIR
  1. K ^TMP("ACDRL",$J,"QMAN"),^UTILITY("AMQQ TAX",$J)
  1. K DIC,X,Y,DD S X=$P(^ACDTITEM(ACDCRIT,0),U,3),DIC="^AMQQ(5,",DIC(0)="EQXM",DIC("S")="I $P(^(0),U,14)" D ^DIC K DIC,DA,DINUM,DICR I Y=-1 W "OOPS - QMAN NOT CURRENT - QUITTING" Q
  1. S ACDQMAN=+Y
  1. D ^AMQQGTX0(ACDQMAN,"^TMP(""ACDRL"",$J,""QMAN"",")
  1. I '$D(^TMP("ACDRL",$J,"QMAN")) W !!,$C(7),"** No ",$P(^ACDTITEM(ACDCRIT,0),U)," selected, all will be included." Q
  1. I $D(^TMP("ACDRL",$J,"QMAN","*")) K ^TMP("ACDRL",$J,"QMAN")
  1. S ^ACDRPTD(ACDRPT,11,ACDCRIT,0)=ACDCRIT,^ACDRPTD(ACDRPT,11,"B",ACDCRIT,ACDCRIT)=""
  1. S X="",Y=0 F S X=$O(^TMP("ACDRL",$J,"QMAN",X)) Q:X="" S Y=Y+1,^ACDRPTD(ACDRPT,11,ACDCRIT,11,Y,0)=X,^ACDRPTD(ACDRPT,11,ACDCRIT,11,"B",X,Y)="",^ACDRPTD(ACDRPT,11,ACDCRIT,11,0)="^9002171.8110101A^"_Y_"^"_Y
  1. K X,Y,Z,ACDQMAN,V
  1. K ^TMP("ACDRL",$J,"QMAN")
  1. Q
  1. R ;EP
  1. K DIR,DIRUT,DUOUT,DTOUT,DA
  1. S DIR(0)=$P(^ACDTITEM(ACDCRIT,0),U,4)_"O",DIR("A")="ENTER "_$P(^(0),U) D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1. Q:$D(DIRUT)
  1. I Y="" Q
  1. S ^ACDRPTD(ACDRPT,11,ACDCRIT,0)=ACDCRIT,^ACDRPTD(ACDRPT,11,"B",ACDCRIT,ACDCRIT)=""
  1. S ACDCNT=ACDCNT+1,^ACDRPTD(ACDRPT,11,ACDCRIT,11,ACDCNT,0)=$P(Y,U),^ACDRPTD(ACDRPT,11,ACDCRIT,11,"B",$P(Y,U),ACDCNT)="",^ACDRPTD(ACDRPT,11,ACDCRIT,11,0)="^9002171.8110101A^"_ACDCNT_"^"_ACDCNT
  1. G R
  1. Q
  1. D ;DATE RANGE
  1. BD ;get beginning date
  1. W ! S DIR(0)="D^::EP",DIR("A")="Enter beginning "_ACDTEXT_" for Search" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1. I $D(DIRUT) Q
  1. S ACDGDB=Y
  1. ED ;get ending date
  1. W ! S DIR(0)="D^"_ACDGDB_"::EP",DIR("A")="Enter ending "_ACDTEXT_" for Search" S Y=ACDGDB D DD^%DT S DIR("B")=Y,Y="" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1. I $D(DIRUT) G BD
  1. S ACDGDE=Y
  1. S X1=ACDGDB,X2=-1 D C^%DTC S ACDGDS=X
  1. ;
  1. S ^ACDRPTD(ACDRPT,11,ACDCRIT,0)=ACDCRIT,^ACDRPTD(ACDRPT,11,"B",ACDCRIT,ACDCRIT)=""
  1. S ACDCNT=0,^ACDRPTD(ACDRPT,11,ACDCRIT,11,ACDCNT,0)="^9002171.8110101A^1^1" S ACDCNT=ACDCNT+1,^ACDRPTD(ACDRPT,11,ACDCRIT,11,1,0)=ACDGDB_U_ACDGDE,^ACDRPTD(ACDRPT,11,ACDCRIT,11,"B",ACDGDB,ACDCNT)=""
  1. Q
  1. N ;
  1. K ^ACDRPTD(ACDRPT,11,ACDCRIT),^ACDRPTD(ACDRPT,11,"B",ACDCRIT)
  1. S DIR(0)="FO^1:7",DIR("A")="Enter a Range of numbers (e.g. 5-12,1-1)" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1. I Y="" W !!,"No numeric range entered. All numerics will be included." Q
  1. I Y'?1.3N1"-"1.3N W !!,$C(7),$C(7),"Enter a numeric range in the format nnn-nnn. E.g. 0-5, 0-99, 5-20." G N
  1. I $D(^ACDTITEM(ACDCRIT,25)) S X=Y X ^(25) I '$D(X) G N ;if input tx exists and fails G N
  1. I '$D(^ACDTITEM(ACDCRIT,25)),Y'?1.3N1"-"1.3N W !!,$C(7),$C(7),"Enter a numeric range in the format nnn-nnn. E.g. 0-5, 0-99, 5-20." G N
  1. S ^ACDRPTD(ACDRPT,11,ACDCRIT,0)=ACDCRIT,^ACDRPTD(ACDRPT,11,"B",ACDCRIT,ACDCRIT)=""
  1. S ^ACDRPTD(ACDRPT,11,ACDCRIT,0)=ACDCRIT,^ACDRPTD(ACDRPT,11,"B",ACDCRIT,ACDCRIT)=""
  1. S ^ACDRPTD(ACDRPT,11,ACDCRIT,11,0)="^9002171.82110101A^1^1" S ^ACDRPTD(ACDRPT,11,ACDCRIT,11,1,0)=$P(Y,"-"),^ACDRPTD(ACDRPT,11,ACDCRIT,11,"B",$P(Y,"-"),1)=""
  1. S $P(^ACDRPTD(ACDRPT,11,ACDCRIT,11,1,0),U,2)=$P(Y,"-",2)
  1. Q
  1. F ;FREE TEXT RANGE
  1. K ^ACDRPTD(ACDRPT,11,ACDCRIT),^ACDRPTD(ACDRPT,11,"B",ACDCRIT)
  1. S DIR(0)="FO^1:20",DIR("A")="Enter a Range of Characters for Search (e.g. A:B) " D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1. I Y="" W !!,"No range entered. All ",ACDTEXT," will be included." Q
  1. I Y'?1.ANP1":"1.ANP W !!,$C(7),$C(7),"Enter an free text range in the format AAA:AAA. E.g. 94-01:94-200, CA:CZ, A:Z." G F
  1. S ^ACDRPTD(ACDRPT,11,ACDCRIT,0)=ACDCRIT,^ACDRPTD(ACDRPT,11,"B",ACDCRIT,ACDCRIT)=""
  1. S ACDCNT=0,^ACDRPTD(ACDRPT,11,ACDCRIT,11,ACDCNT,0)="^9002171.8110101A^1^1" S ACDCNT=ACDCNT+1,^ACDRPTD(ACDRPT,11,ACDCRIT,11,1,0)=$P(X,":")_U_$P(X,":",2),^ACDRPTD(ACDRPT,11,ACDCRIT,11,"B",$P(X,":"),ACDCNT)=""
  1. Q
  1. Y ;
  1. D Y^ACDRL01
  1. Q
  1. SPECIAL ;
  1. D SPECIAL^ACDRL01
  1. Q