ACDRL01 ;IHS/ADC/EDE/KML - SCREEN LOGIC;
;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
;
;
INFORM ;EP
S ACDTCW=0
W:$D(IOF) @IOF
S ACDLHDR="CHEMICAL DEPENDENCY MIS GENERAL RETRIEVAL"
W ?((80-$L(ACDLHDR))/2),ACDLHDR
W !!!,"This report will produce a listing of ",$S(ACDPTVS="V":"records",1:"Patients")," in a date range selected by the",!,"user. "
W "The ",$S(ACDPTVS="V":"records",1:"Patients")," printed can be selected based on any combination of items.",!,"The user will select these criteria. The items printed on the report",!
W "are also selected by the user.",!!,"If selected print data items exceed 80 characters, a 132-column capacity",!,"printer will be needed.",!!
S (ACDPCNT,ACDPTCT)=0 ;ACDPTCT -- pt total for # of "V"isits
K ACDRDTR,ACDBDD,ACDBD,ACDEDD,ACDED
;S ACDXREF=$S(ACDPTVS="V":"C",1:"PO")
S ACDXREF="C"
Q
;
ADD ;EP
K ACDCAND
W !!
I $D(ACDSEAT),'$D(ACDEP1) G ADD1
S DIR(0)="Y",DIR("A")="Do you want to use a PREVIOUSLY DEFINED REPORT",DIR("B")="N" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) S ACDQUIT=1 Q
I 'Y G ADD1
S DIC="^ACDRPTD(",DIC("S")="I $P(^(0),U,2)&($P(^(0),U,6)=ACDPTVS)" S:$D(ACDEP1) DIC("S")=DIC("S")_"&($P(^(0),U,9)=ACDPACK)" S DIC(0)="AEQ",DIC("A")="REPORT NAME: ",D="C" D IX^DIC K DIC,DA,DR
I Y=-1 S ACDQUIT=1 Q
S ACDRPT=+Y,ACDCAND=1
;--- set up sorting and report control variables
S ACDSORT=$P(^ACDRPTD(ACDRPT,0),U,7),ACDSORV=$P(^(0),U,8),ACDSPAG=$P(^(0),U,4),ACDCTYP=$P(^(0),U,5)
S X=0 F S X=$O(^ACDRPTD(ACDRPT,12,X)) Q:X'=+X S ACDTCW=ACDTCW+$P(^ACDRPTD(ACDRPT,12,X,0),U,2)+2
Q
ADD1 ;
;CREATE REPORT ENTRY IN FILEMAN FILE
S %H=$H D YX^%DTC S X=$P(^VA(200,DUZ,0),U)_"-"_Y,DIC(0)="L",DIC="^ACDRPTD(",DLAYGO=9002171.8,DIADD=1 D ^DIC K DIC,DA,DR,DIADD,DLAYGO I Y=-1 W !!,"UNABLE TO CREATE REPORT FILE ENTRY - NOTIFY SITE MANAGER!" S ACDQUIT=1 Q
S ACDRPT=+Y
K DIC,DIADD,DLAYGO,DR,DA,DD,X,Y,DINUM
;DELETE ALL 11 MULTIPLE HERE
K ^ACDRPTD(ACDRPT,11)
Q
PAUSE ;EP
Q:$E(IOST)'="C"!(IO'=IO(0))
W ! S DIR(0)="EO",DIR("A")="Hit return to continue...." D ^DIR K DIR S:$D(DUOUT) DIRUT=1
Q
Y ;EP - called from apclvl0
S DIR(0)="S^1:"_ACDTEXT_";0:NO "_ACDTEXT_"",DIR("A")="Should "_$S(ACDPTVS="P":"patient",1:"visit")_" have",DIR("B")="1" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
Q:$D(DIRUT)
Q:Y=""
S ^ACDRPTD(ACDRPT,11,ACDCRIT,0)=ACDCRIT,^ACDRPTD(ACDRPT,11,"B",ACDCRIT,ACDCRIT)=""
S ^ACDRPTD(ACDRPT,11,ACDCRIT,11,1,0)=Y,^ACDRPTD(ACDRPT,11,ACDCRIT,11,"B",Y,1)="",^ACDRPTD(ACDRPT,11,ACDCRIT,11,0)="^9002171.8110101A^"_1_"^"_1
Q
SPECIAL ;EP
K ^ACDRPTD(ACDRPT,11,ACDCRIT),^ACDTPRT(ACDRPT,11,"B",ACDCRIT)
S Y="" X:$D(^ACDTITEM(ACDCRIT,4)) ^(4)
I Y="" Q
S ^ACDRPTD(ACDRPT,11,ACDCRIT,0)=ACDCRIT,^ACDRPTD(ACDRPT,11,"B",ACDCRIT,ACDCRIT)=""
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
Q
ACDRL01 ;IHS/ADC/EDE/KML - SCREEN LOGIC;
+1 ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
+2 ;
+3 ;
INFORM ;EP
+1 SET ACDTCW=0
+2 IF $DATA(IOF)
WRITE @IOF
+3 SET ACDLHDR="CHEMICAL DEPENDENCY MIS GENERAL RETRIEVAL"
+4 WRITE ?((80-$LENGTH(ACDLHDR))/2),ACDLHDR
+5 WRITE !!!,"This report will produce a listing of ",$SELECT(ACDPTVS="V":"records",1:"Patients")," in a date range selected by the",!,"user. "
+6 WRITE "The ",$SELECT(ACDPTVS="V":"records",1:"Patients")," printed can be selected based on any combination of items.",!,"The user will select these criteria. The items printed on the report",!
+7 WRITE "are also selected by the user.",!!,"If selected print data items exceed 80 characters, a 132-column capacity",!,"printer will be needed.",!!
+8 ;ACDPTCT -- pt total for # of "V"isits
SET (ACDPCNT,ACDPTCT)=0
+9 KILL ACDRDTR,ACDBDD,ACDBD,ACDEDD,ACDED
+10 ;S ACDXREF=$S(ACDPTVS="V":"C",1:"PO")
+11 SET ACDXREF="C"
+12 QUIT
+13 ;
ADD ;EP
+1 KILL ACDCAND
+2 WRITE !!
+3 IF $DATA(ACDSEAT)
IF '$DATA(ACDEP1)
GOTO ADD1
+4 SET DIR(0)="Y"
SET DIR("A")="Do you want to use a PREVIOUSLY DEFINED REPORT"
SET DIR("B")="N"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+5 IF $DATA(DIRUT)
SET ACDQUIT=1
QUIT
+6 IF 'Y
GOTO ADD1
+7 SET DIC="^ACDRPTD("
SET DIC("S")="I $P(^(0),U,2)&($P(^(0),U,6)=ACDPTVS)"
IF $DATA(ACDEP1)
SET DIC("S")=DIC("S")_"&($P(^(0),U,9)=ACDPACK)"
SET DIC(0)="AEQ"
SET DIC("A")="REPORT NAME: "
SET D="C"
DO IX^DIC
KILL DIC,DA,DR
+8 IF Y=-1
SET ACDQUIT=1
QUIT
+9 SET ACDRPT=+Y
SET ACDCAND=1
+10 ;--- set up sorting and report control variables
+11 SET ACDSORT=$PIECE(^ACDRPTD(ACDRPT,0),U,7)
SET ACDSORV=$PIECE(^(0),U,8)
SET ACDSPAG=$PIECE(^(0),U,4)
SET ACDCTYP=$PIECE(^(0),U,5)
+12 SET X=0
FOR
SET X=$ORDER(^ACDRPTD(ACDRPT,12,X))
IF X'=+X
QUIT
SET ACDTCW=ACDTCW+$PIECE(^ACDRPTD(ACDRPT,12,X,0),U,2)+2
+13 QUIT
ADD1 ;
+1 ;CREATE REPORT ENTRY IN FILEMAN FILE
+2 SET %H=$HOROLOG
DO YX^%DTC
SET X=$PIECE(^VA(200,DUZ,0),U)_"-"_Y
SET DIC(0)="L"
SET DIC="^ACDRPTD("
SET DLAYGO=9002171.8
SET DIADD=1
DO ^DIC
KILL DIC,DA,DR,DIADD,DLAYGO
IF Y=-1
WRITE !!,"UNABLE TO CREATE REPORT FILE ENTRY - NOTIFY SITE MANAGER!"
SET ACDQUIT=1
QUIT
+3 SET ACDRPT=+Y
+4 KILL DIC,DIADD,DLAYGO,DR,DA,DD,X,Y,DINUM
+5 ;DELETE ALL 11 MULTIPLE HERE
+6 KILL ^ACDRPTD(ACDRPT,11)
+7 QUIT
PAUSE ;EP
+1 IF $EXTRACT(IOST)'="C"!(IO'=IO(0))
QUIT
+2 WRITE !
SET DIR(0)="EO"
SET DIR("A")="Hit return to continue...."
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+3 QUIT
Y ;EP - called from apclvl0
+1 SET DIR(0)="S^1:"_ACDTEXT_";0:NO "_ACDTEXT_""
SET DIR("A")="Should "_$SELECT(ACDPTVS="P":"patient",1:"visit")_" have"
SET DIR("B")="1"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
QUIT
+3 IF Y=""
QUIT
+4 SET ^ACDRPTD(ACDRPT,11,ACDCRIT,0)=ACDCRIT
SET ^ACDRPTD(ACDRPT,11,"B",ACDCRIT,ACDCRIT)=""
+5 SET ^ACDRPTD(ACDRPT,11,ACDCRIT,11,1,0)=Y
SET ^ACDRPTD(ACDRPT,11,ACDCRIT,11,"B",Y,1)=""
SET ^ACDRPTD(ACDRPT,11,ACDCRIT,11,0)="^9002171.8110101A^"_1_"^"_1
+6 QUIT
SPECIAL ;EP
+1 KILL ^ACDRPTD(ACDRPT,11,ACDCRIT),^ACDTPRT(ACDRPT,11,"B",ACDCRIT)
+2 SET Y=""
IF $DATA(^ACDTITEM(ACDCRIT,4))
XECUTE ^(4)
+3 IF Y=""
QUIT
+4 SET ^ACDRPTD(ACDRPT,11,ACDCRIT,0)=ACDCRIT
SET ^ACDRPTD(ACDRPT,11,"B",ACDCRIT,ACDCRIT)=""
+5 SET ACDCNT=ACDCNT+1
SET ^ACDRPTD(ACDRPT,11,ACDCRIT,11,ACDCNT,0)=$PIECE(Y,U)
SET ^ACDRPTD(ACDRPT,11,ACDCRIT,11,"B",$PIECE(Y,U),ACDCNT)=""
SET ^ACDRPTD(ACDRPT,11,ACDCRIT,11,0)="^9002171.8110101A^"_ACDCNT_"^"_ACDCNT
+6 QUIT
