ACMSRT1 ; IHS/TUCSON/TMJ - ACMSRT SUBROUTINE ;
;;2.0;ACM CASE MANAGEMENT SYSTEM;;JAN 10, 1996
SD I BY["DATE LAST PRINTED" S FR=FR_",",TO=TO_"," Q
W !!
S %DT("A")="Start with what date: ",%DT="AEQ" D ^%DT
I X=U S ACMQUIT="" Q
I X="" S Y=X
S $P(FR,",",ACMN)=Y
S %DT("A")="End with what date: ",%DT="AEQ" D ^%DT
I X=U S ACMQUIT="" Q
I X="" S Y=X
S $P(TO,",",ACMN)=Y
Q
;
SA W !!
GAGE S DIR(0)="NOA^0:120",DIR("A")="Start with what AGE: ",DIR("?")="Enter any AGE in years (including 0)"
D ^DIR K DIR
I $E(X)=U S ACMQUIT="" Q
I X="" S Y=0
S ACMYX=Y
GAGEA S $P(FR,",",ACMN)=Y
SAGE W !
GAGE1 S DIR(0)="NOA^0:120",DIR("A")="Go to what AGE: ",DIR("?")="Enter any AGE in years (must be at least "_ACMYX_")"
D ^DIR K DIR
I $E(X)=U S ACMQUIT="" Q
I X="" S Y=188
S ACMYX=Y
SAGE1 S $P(TO,",",ACMN)=Y
Q
;
SS W !!
S %=$P(^ACM(48.5,ACMSNO,0),U,5),ACMYX=$P(^(0),U,8),%=U_%_"0)",%=+$P(@%,U,2),%=^DD(%,ACMYX,0),ACMSET=";"_$P(%,U,3)
W "Do you want to sort by a particular ",ACMSNA
S %=2 D YN^DICN
I %Y=U S ACMQUIT="" Q
I "Nn"[$E(%Y) Q
D SL
I %Y?1."?" G SS
SSG S DIR(0)="FOA^1:10",DIR("A")="Your choice: ",DIR("?")="Type either the code or the text of the item you wish to select"
D ^DIR K DIR
I U[$E(X) S ACMQUIT="" Q
Q:X=""
S ACMYX=Y
S %=ACMSET,Y=$F(%,(";"_ACMYX))
I Y S ACMYZ=$E(%,Y,99),ACMYZ=$P(ACMYZ,":",2),ACMYZ=$P(ACMYZ,";"),$P(FR,",",ACMN)=ACMYZ,$P(TO,",",ACMN)=ACMYZ W " = ",ACMYZ Q
F ACMI=2:1 S ACMYZ=$P(%,":",ACMI) Q:ACMYZ="" I $E(ACMYZ,1,$L(ACMYX))=ACMYX S ACMYZ=$P(ACMYZ,";"),$P(FR,",",ACMN)=ACMYZ,$P(TO,",",ACMN)=ACMYZ W $E(ACMYZ,$L(ACMYX)+1,99) Q
I ACMYZ="" W " ??",*7 G SSG
Q
;
SL W !!,"You may select one of the following choices",!
F ACMI=2:1 S %=$P(ACMSET,";",ACMI) Q:%="" S ACMYX=$P(%,":"),Y=$P(%,":",2) W !,?5,ACMYX," = ",Y
Q
;
SP W !!
S DIC=U_$P(^ACM(48.5,ACMSNO,0),U,7)
S ACMDIC1=U_$P($P(ACMNAV,U,7),",")_")"
W "Do you want to sort by a particular ",ACMSNA
S %=2 D YN^DICN
I %Y=U S ACMQUIT="" Q
I "Nn"[$E(%Y) Q
SPQ S DIC("A")="Which "_ACMSNA_": "
I '$P(^ACM(41.1,ACMRG,0),U,8) S:ACMDIC'=41&(ACMDIC'=46)&(ACMDIC'=57)&(ACMDIC'=50)&(DIC'["DPT")&(DIC'["AUTT")&(DIC'["VA")&(ACMDIC1'["^ACM(42.3") DIC("S")="I $D(@ACMDIC1@(+Y,""RG"",""B"",ACMRG))"
I $D(ACMDM),DIC["41," S DIC("S")="I $P(^(0),U)=ACMRG"
I $D(ACMDM),DIC["DPT" S DIC("S")="I $D(^ACM(41,""AC"",+Y,ACMRG))"
S DIC(0)="AEMIQZ"
N I D DIC K ACMDIC1
I X=U S ACMQUIT="" Q
I X="" Q
SPQ1 I BY["[" G SPQ11
N ACMYX,ACMYZ,% S ACMYX=$L(BY,","),%=$P(BY,",",ACMYX)
I %="" Q
I %'[";" S BY=BY_":NUMBER="_+Y Q
S ACMYZ=$P(%,";")
S $P(%,";",1)=ACMYZ_":NUMBER="_+Y
S $P(BY,",",ACMYX)=%
Q
SPQ11 S FR=$P(Y,U,2),TO=FR_"z" Q
;
SF W !!
W "Do you want to sort by a particular ",ACMSNA
S %=2 D YN^DICN
I %Y=U S ACMQUIT="" Q
I "Nn"[$E(%Y) Q
SFQ S DIC("A")="Which "_ACMSNA_": "
S DIC(0)="AEMQZ",DIC=ACMDIC
I ACMSNA["CURRENT COMMUNITY" S DIC="^AUTTCOM("
I ACMSNA["REGISTER-" S DIC="^ACM(41.1,"
D DIC
I X=U S ACMQUIT="" Q
I X="" Q
I ACMSNA["REGISTER-" S FR=Y(0,0),TO=FR_"z" Q
I FR="" S FR=Y(0,0)
E S FR=FR_","_Y(0,0)
I TO="" S TO=Y(0,0)_"z"
E S TO=TO_","_Y(0,0)_"z"
Q
DIC W ! D ^DIC K DIC Q
EXIT ;EP;TO KILL VARIABLES
K ACMYX,Y,ACMYZ,%Y,%DT,ACMZ,ACMZZ,ACMDIC,ACMN,ACMPTMP,BY,FR,TO,FLDS,I
K ACMSNO,ACMSNA,ACMU,ACMUB,ACMXZ,ACMQUIT,ACMJ1,ACMUB,ACMU,ACMYII
K ACMX,ACMY,ACMRPT,ACMSET,ACMMAND,ACMCSTG,ACMMANN,ACMMAN,ACMFILE,ACMSRT
K APCRREG,APCRREGP,APCRN,APCHSPAT,APCHSTYP,ACMYZ
D ^%ZISC
S IOP=ION D ^%ZIS Q
PS ;EP - called from acmsrt
S DIR(0)="SOA^P:Patient;S:Statistical",DIR("A")=" 'P'atient or 'S'tatistical report? ==> ",DIR("?")="Enter 'P' for patient or 'S' for statistical reports"
W !
D ^DIR K DIR
I U=$E(X)!(X="") S ACMQUIT="" Q
S ACMX=Y
Q:ACMX="P"
S FLDS="[ACM "_ACMRPT_" COUNT]"
F ACMJ="@","#" I $D(BY),BY[ACMJ F ACMI=0:0 S ACMBY1=$P(BY,ACMJ),ACMBY2=$P(BY,ACMJ,2),BY=ACMBY1_ACMBY2 Q:BY'[ACMJ
I $D(BY) S ACMBC=$L(BY,",") F ACMJ=1:1:ACMBC S $P(BY,",",ACMJ)="+"_$P(BY,",",ACMJ)
K ACMX,ACMBC
Q
ACMSRT1 ; IHS/TUCSON/TMJ - ACMSRT SUBROUTINE ;
+1 ;;2.0;ACM CASE MANAGEMENT SYSTEM;;JAN 10, 1996
SD IF BY["DATE LAST PRINTED"
SET FR=FR_","
SET TO=TO_","
QUIT
+1 WRITE !!
+2 SET %DT("A")="Start with what date: "
SET %DT="AEQ"
DO ^%DT
+3 IF X=U
SET ACMQUIT=""
QUIT
+4 IF X=""
SET Y=X
+5 SET $PIECE(FR,",",ACMN)=Y
+6 SET %DT("A")="End with what date: "
SET %DT="AEQ"
DO ^%DT
+7 IF X=U
SET ACMQUIT=""
QUIT
+8 IF X=""
SET Y=X
+9 SET $PIECE(TO,",",ACMN)=Y
+10 QUIT
+11 ;
SA WRITE !!
GAGE SET DIR(0)="NOA^0:120"
SET DIR("A")="Start with what AGE: "
SET DIR("?")="Enter any AGE in years (including 0)"
+1 DO ^DIR
KILL DIR
+2 IF $EXTRACT(X)=U
SET ACMQUIT=""
QUIT
+3 IF X=""
SET Y=0
+4 SET ACMYX=Y
GAGEA SET $PIECE(FR,",",ACMN)=Y
SAGE WRITE !
GAGE1 SET DIR(0)="NOA^0:120"
SET DIR("A")="Go to what AGE: "
SET DIR("?")="Enter any AGE in years (must be at least "_ACMYX_")"
+1 DO ^DIR
KILL DIR
+2 IF $EXTRACT(X)=U
SET ACMQUIT=""
QUIT
+3 IF X=""
SET Y=188
+4 SET ACMYX=Y
SAGE1 SET $PIECE(TO,",",ACMN)=Y
+1 QUIT
+2 ;
SS WRITE !!
+1 SET %=$PIECE(^ACM(48.5,ACMSNO,0),U,5)
SET ACMYX=$PIECE(^(0),U,8)
SET %=U_%_"0)"
SET %=+$PIECE(@%,U,2)
SET %=^DD(%,ACMYX,0)
SET ACMSET=";"_$PIECE(%,U,3)
+2 WRITE "Do you want to sort by a particular ",ACMSNA
+3 SET %=2
DO YN^DICN
+4 IF %Y=U
SET ACMQUIT=""
QUIT
+5 IF "Nn"[$EXTRACT(%Y)
QUIT
+6 DO SL
+7 IF %Y?1."?"
GOTO SS
SSG SET DIR(0)="FOA^1:10"
SET DIR("A")="Your choice: "
SET DIR("?")="Type either the code or the text of the item you wish to select"
+1 DO ^DIR
KILL DIR
+2 IF U[$EXTRACT(X)
SET ACMQUIT=""
QUIT
+3 IF X=""
QUIT
+4 SET ACMYX=Y
+5 SET %=ACMSET
SET Y=$FIND(%,(";"_ACMYX))
+6 IF Y
SET ACMYZ=$EXTRACT(%,Y,99)
SET ACMYZ=$PIECE(ACMYZ,":",2)
SET ACMYZ=$PIECE(ACMYZ,";")
SET $PIECE(FR,",",ACMN)=ACMYZ
SET $PIECE(TO,",",ACMN)=ACMYZ
WRITE " = ",ACMYZ
QUIT
+7 FOR ACMI=2:1
SET ACMYZ=$PIECE(%,":",ACMI)
IF ACMYZ=""
QUIT
IF $EXTRACT(ACMYZ,1,$LENGTH(ACMYX))=ACMYX
SET ACMYZ=$PIECE(ACMYZ,";")
SET $PIECE(FR,",",ACMN)=ACMYZ
SET $PIECE(TO,",",ACMN)=ACMYZ
WRITE $EXTRACT(ACMYZ,$LENGTH(ACMYX)+1,99)
QUIT
+8 IF ACMYZ=""
WRITE " ??",*7
GOTO SSG
+9 QUIT
+10 ;
SL WRITE !!,"You may select one of the following choices",!
+1 FOR ACMI=2:1
SET %=$PIECE(ACMSET,";",ACMI)
IF %=""
QUIT
SET ACMYX=$PIECE(%,":")
SET Y=$PIECE(%,":",2)
WRITE !,?5,ACMYX," = ",Y
+2 QUIT
+3 ;
SP WRITE !!
+1 SET DIC=U_$PIECE(^ACM(48.5,ACMSNO,0),U,7)
+2 SET ACMDIC1=U_$PIECE($PIECE(ACMNAV,U,7),",")_")"
+3 WRITE "Do you want to sort by a particular ",ACMSNA
+4 SET %=2
DO YN^DICN
+5 IF %Y=U
SET ACMQUIT=""
QUIT
+6 IF "Nn"[$EXTRACT(%Y)
QUIT
SPQ SET DIC("A")="Which "_ACMSNA_": "
+1 IF '$PIECE(^ACM(41.1,ACMRG,0),U,8)
IF ACMDIC'=41&(ACMDIC'=46)&(ACMDIC'=57)&(ACMDIC'=50)&(DIC'["DPT")&(DIC'["AUTT")&(DIC'["VA")&(ACMDIC1'["^ACM(42.3")
SET DIC("S")="I $D(@ACMDIC1@(+Y,""RG"",""B"",ACMRG))"
+2 IF $DATA(ACMDM)
IF DIC["41,"
SET DIC("S")="I $P(^(0),U)=ACMRG"
+3 IF $DATA(ACMDM)
IF DIC["DPT"
SET DIC("S")="I $D(^ACM(41,""AC"",+Y,ACMRG))"
+4 SET DIC(0)="AEMIQZ"
+5 NEW I
DO DIC
KILL ACMDIC1
+6 IF X=U
SET ACMQUIT=""
QUIT
+7 IF X=""
QUIT
SPQ1 IF BY["["
GOTO SPQ11
+1 NEW ACMYX,ACMYZ,%
SET ACMYX=$LENGTH(BY,",")
SET %=$PIECE(BY,",",ACMYX)
+2 IF %=""
QUIT
+3 IF %'[";"
SET BY=BY_":NUMBER="_+Y
QUIT
+4 SET ACMYZ=$PIECE(%,";")
+5 SET $PIECE(%,";",1)=ACMYZ_":NUMBER="_+Y
+6 SET $PIECE(BY,",",ACMYX)=%
+7 QUIT
SPQ11 SET FR=$PIECE(Y,U,2)
SET TO=FR_"z"
QUIT
+1 ;
SF WRITE !!
+1 WRITE "Do you want to sort by a particular ",ACMSNA
+2 SET %=2
DO YN^DICN
+3 IF %Y=U
SET ACMQUIT=""
QUIT
+4 IF "Nn"[$EXTRACT(%Y)
QUIT
SFQ SET DIC("A")="Which "_ACMSNA_": "
+1 SET DIC(0)="AEMQZ"
SET DIC=ACMDIC
+2 IF ACMSNA["CURRENT COMMUNITY"
SET DIC="^AUTTCOM("
+3 IF ACMSNA["REGISTER-"
SET DIC="^ACM(41.1,"
+4 DO DIC
+5 IF X=U
SET ACMQUIT=""
QUIT
+6 IF X=""
QUIT
+7 IF ACMSNA["REGISTER-"
SET FR=Y(0,0)
SET TO=FR_"z"
QUIT
+8 IF FR=""
SET FR=Y(0,0)
+9 IF '$TEST
SET FR=FR_","_Y(0,0)
+10 IF TO=""
SET TO=Y(0,0)_"z"
+11 IF '$TEST
SET TO=TO_","_Y(0,0)_"z"
+12 QUIT
DIC WRITE !
DO ^DIC
KILL DIC
QUIT
EXIT ;EP;TO KILL VARIABLES
+1 KILL ACMYX,Y,ACMYZ,%Y,%DT,ACMZ,ACMZZ,ACMDIC,ACMN,ACMPTMP,BY,FR,TO,FLDS,I
+2 KILL ACMSNO,ACMSNA,ACMU,ACMUB,ACMXZ,ACMQUIT,ACMJ1,ACMUB,ACMU,ACMYII
+3 KILL ACMX,ACMY,ACMRPT,ACMSET,ACMMAND,ACMCSTG,ACMMANN,ACMMAN,ACMFILE,ACMSRT
+4 KILL APCRREG,APCRREGP,APCRN,APCHSPAT,APCHSTYP,ACMYZ
+5 DO ^%ZISC
+6 SET IOP=ION
DO ^%ZIS
QUIT
PS ;EP - called from acmsrt
+1 SET DIR(0)="SOA^P:Patient;S:Statistical"
SET DIR("A")=" 'P'atient or 'S'tatistical report? ==> "
SET DIR("?")="Enter 'P' for patient or 'S' for statistical reports"
+2 WRITE !
+3 DO ^DIR
KILL DIR
+4 IF U=$EXTRACT(X)!(X="")
SET ACMQUIT=""
QUIT
+5 SET ACMX=Y
+6 IF ACMX="P"
QUIT
+7 SET FLDS="[ACM "_ACMRPT_" COUNT]"
+8 FOR ACMJ="@","#"
IF $DATA(BY)
IF BY[ACMJ
FOR ACMI=0:0
SET ACMBY1=$PIECE(BY,ACMJ)
SET ACMBY2=$PIECE(BY,ACMJ,2)
SET BY=ACMBY1_ACMBY2
IF BY'[ACMJ
QUIT
+9 IF $DATA(BY)
SET ACMBC=$LENGTH(BY,",")
FOR ACMJ=1:1:ACMBC
SET $PIECE(BY,",",ACMJ)="+"_$PIECE(BY,",",ACMJ)
+10 KILL ACMX,ACMBC
+11 QUIT
