ACMRL1 ; IHS/TUCSON/TMJ - PROCESS LISTER ; [ 06/01/1999 1:48 PM ]
;;2.0;ACM CASE MANAGEMENT SYSTEM;**1**;JAN 10, 1996
;IHS/CMI/LAB - patch 1 tmp to xtmp
;
;
;
START ;
S (ACMBT,ACMBTH)=$H,ACMJOB=$J,ACMRCNT=0
S ^XTMP("ACMRL",0)=$$FMADD^XLFDT(DT,14)_U_DT_U_"CASE MANAGEMENT GENERAL RETRIEVAL"
D P
Q
;
P ;
S DFN=0 F S DFN=$O(^ACM(41,"AC",DFN)) Q:DFN'=+DFN I $D(^ACM(41,"AC",DFN,ACMRG)),'$P(^DPT(DFN,0),U,19) S ACMIFN=^ACM(41,"AC",DFN,ACMRG) D PROC
Q
;
;
END ;
S ACMET=$H
D EOJ
Q
EOJ ;
Q
PROC ;
D SCREENS
Q:$D(ACMSKIP)
K ACMSRT,ACMPRNT S ACMCRIT=ACMSORT,ACMX=0
X:$D(^ACM(58.1,ACMSORT,4)) ^ACM(58.1,ACMSORT,4) I $G(ACMPRNT)="" S ACMPRNT="--"
S ACMSRT=ACMPRNT
S ^XTMP("ACMRL",ACMJOB,ACMBTH,"DATA HITS",ACMSRT,DFN)="",ACMRCNT=ACMRCNT+1
Q:$D(^XTMP("ACMRL",ACMJOB,ACMBTH,"PATIENTS",DFN))!($D(ACMSCNT))
S ^XTMP("ACMRL",ACMJOB,ACMBTH,"PATIENTS",DFN)="",ACMPTCT=ACMPTCT+1
Q
SCREENS ;
K ACMSKIP
S ACMI=0 F S ACMI=$O(^ACM(58.8,ACMRPT,11,ACMI)) Q:ACMI'=+ACMI!($D(ACMSKIP)) D
.I '$P(^ACM(58.1,ACMI,0),U,8) D SINGLE Q
.D MULT
.Q
Q
SINGLE ;
K X,ACMSPEC S X="",ACMX=0
X:$D(^ACM(58.1,ACMI,1)) ^(1)
I X="" S ACMSKIP="" Q
I '$D(ACMSPEC),'$D(^ACM(58.8,ACMRPT,11,ACMI,11,"B",X)) S ACMSKIP="" Q
Q
MULT ;
K ACMFOUN,ACMSKIP,ACMSPEC,X S ACMX=0,X=""
X:$D(^ACM(58.1,ACMI,1)) ^(1)
I $O(X(""))="" S ACMSKIP="" Q
I '$D(ACMSPEC) S Y="" F S Y=$O(X(Y)) Q:Y="" I $D(^ACM(58.8,ACMRPT,11,ACMI,11,"B",Y)) S ACMFOUN="" Q
I $D(ACMSPEC),$D(X) S ACMFOUN=1 Q
S:'$D(ACMFOUN) ACMSKIP=""
Q
XIT ;EP - CALLED FROM ACMRL
K ACMBD,ACMBDD,ACMED,ACMEDD,ACMSD,ACMSORT,ACMSORV,ACMTCW,ACMRPT,ACMLHDR,ACMDISP,%H,ACMET,ACMLINE,ACMPRNM,ACMPRNT,ACMSKIP,ACMTYPE,ACMSPAG,ACMEN1,ACMSEAT,ACMPROC,ACM,ACMCAND,ACMHDR,ACMHEAD,ACMIFN,ACMNCAN
K ACMCTYP,ACMFLG,ACMG,ACMNAME,ACMNIFN,ACMSAVE,ACMTITL,ACMQUIT,ACMPCNT,ACMQFLG,ACMPTCT,ACMTL,ACMSRTR,ACMSRTV
K C,D,D0,DA,DIC,DD,DFN,DIADD,DLAYGO,DICR,DIE,DIK,DINUM,DIQ,DIR,DIRUT,DUOUT,DHD,DTOUT,DR,J,I,J,K,M,S,TS,X,Y,DIG,DIH,DIV,DQ,DDH,AMQQEN3,AMQQLX,DHIT
XIT1 ;EP
K ACMANS,ACMBTH,ACMC,ACMCNT,ACMCRIT,ACMCUT,ACMD,ACMDISP,ACMDONE,ACMHIGH,ACMI,ACMJOB,ACMQMAN,ACMSEL,ACMTEXT,ACMVAR,ACMSKIP,ACMPRNT,ACMPRNM,ACMLINE,ACMRCNT,ACMSCNT,ACMDFET,ACMY,DFN
K X,X1,X2,IO("Q"),%,Y,POP,DIRUT,ZTSK,ZTQUEUED,H,S,TS,M,ZTIO,DUOUT,DIR,DTOUT,V,Z,I,DIC,DIK,DIADD,DLAYGO,DA,DR,DIE,DIU,AMQQTAX,DINUM,ACMPACK,ACMEP1,ACMEP2,D,ACMLENG,ACMLHDR,ACMSAVE
Q
ACMRL1 ; IHS/TUCSON/TMJ - PROCESS LISTER ; [ 06/01/1999 1:48 PM ]
+1 ;;2.0;ACM CASE MANAGEMENT SYSTEM;**1**;JAN 10, 1996
+2 ;IHS/CMI/LAB - patch 1 tmp to xtmp
+3 ;
+4 ;
+5 ;
START ;
+1 SET (ACMBT,ACMBTH)=$HOROLOG
SET ACMJOB=$JOB
SET ACMRCNT=0
+2 SET ^XTMP("ACMRL",0)=$$FMADD^XLFDT(DT,14)_U_DT_U_"CASE MANAGEMENT GENERAL RETRIEVAL"
+3 DO P
+4 QUIT
+5 ;
P ;
+1 SET DFN=0
FOR
SET DFN=$ORDER(^ACM(41,"AC",DFN))
IF DFN'=+DFN
QUIT
IF $DATA(^ACM(41,"AC",DFN,ACMRG))
IF '$PIECE(^DPT(DFN,0),U,19)
SET ACMIFN=^ACM(41,"AC",DFN,ACMRG)
DO PROC
+2 QUIT
+3 ;
+4 ;
END ;
+1 SET ACMET=$HOROLOG
+2 DO EOJ
+3 QUIT
EOJ ;
+1 QUIT
PROC ;
+1 DO SCREENS
+2 IF $DATA(ACMSKIP)
QUIT
+3 KILL ACMSRT,ACMPRNT
SET ACMCRIT=ACMSORT
SET ACMX=0
+4 IF $DATA(^ACM(58.1,ACMSORT,4))
XECUTE ^ACM(58.1,ACMSORT,4)
IF $GET(ACMPRNT)=""
SET ACMPRNT="--"
+5 SET ACMSRT=ACMPRNT
+6 SET ^XTMP("ACMRL",ACMJOB,ACMBTH,"DATA HITS",ACMSRT,DFN)=""
SET ACMRCNT=ACMRCNT+1
+7 IF $DATA(^XTMP("ACMRL",ACMJOB,ACMBTH,"PATIENTS",DFN))!($DATA(ACMSCNT))
QUIT
+8 SET ^XTMP("ACMRL",ACMJOB,ACMBTH,"PATIENTS",DFN)=""
SET ACMPTCT=ACMPTCT+1
+9 QUIT
SCREENS ;
+1 KILL ACMSKIP
+2 SET ACMI=0
FOR
SET ACMI=$ORDER(^ACM(58.8,ACMRPT,11,ACMI))
IF ACMI'=+ACMI!($DATA(ACMSKIP))
QUIT
Begin DoDot:1
+3 IF '$PIECE(^ACM(58.1,ACMI,0),U,8)
DO SINGLE
QUIT
+4 DO MULT
+5 QUIT
End DoDot:1
+6 QUIT
SINGLE ;
+1 KILL X,ACMSPEC
SET X=""
SET ACMX=0
+2 IF $DATA(^ACM(58.1,ACMI,1))
XECUTE ^(1)
+3 IF X=""
SET ACMSKIP=""
QUIT
+4 IF '$DATA(ACMSPEC)
IF '$DATA(^ACM(58.8,ACMRPT,11,ACMI,11,"B",X))
SET ACMSKIP=""
QUIT
+5 QUIT
MULT ;
+1 KILL ACMFOUN,ACMSKIP,ACMSPEC,X
SET ACMX=0
SET X=""
+2 IF $DATA(^ACM(58.1,ACMI,1))
XECUTE ^(1)
+3 IF $ORDER(X(""))=""
SET ACMSKIP=""
QUIT
+4 IF '$DATA(ACMSPEC)
SET Y=""
FOR
SET Y=$ORDER(X(Y))
IF Y=""
QUIT
IF $DATA(^ACM(58.8,ACMRPT,11,ACMI,11,"B",Y))
SET ACMFOUN=""
QUIT
+5 IF $DATA(ACMSPEC)
IF $DATA(X)
SET ACMFOUN=1
QUIT
+6 IF '$DATA(ACMFOUN)
SET ACMSKIP=""
+7 QUIT
XIT ;EP - CALLED FROM ACMRL
+1 KILL ACMBD,ACMBDD,ACMED,ACMEDD,ACMSD,ACMSORT,ACMSORV,ACMTCW,ACMRPT,ACMLHDR,ACMDISP,%H,ACMET,ACMLINE,ACMPRNM,ACMPRNT,ACMSKIP,ACMTYPE,ACMSPAG,ACMEN1,ACMSEAT,ACMPROC,ACM,ACMCAND,ACMHDR,ACMHEAD,ACMIFN,ACMNCAN
+2 KILL ACMCTYP,ACMFLG,ACMG,ACMNAME,ACMNIFN,ACMSAVE,ACMTITL,ACMQUIT,ACMPCNT,ACMQFLG,ACMPTCT,ACMTL,ACMSRTR,ACMSRTV
+3 KILL C,D,D0,DA,DIC,DD,DFN,DIADD,DLAYGO,DICR,DIE,DIK,DINUM,DIQ,DIR,DIRUT,DUOUT,DHD,DTOUT,DR,J,I,J,K,M,S,TS,X,Y,DIG,DIH,DIV,DQ,DDH,AMQQEN3,AMQQLX,DHIT
XIT1 ;EP
+1 KILL ACMANS,ACMBTH,ACMC,ACMCNT,ACMCRIT,ACMCUT,ACMD,ACMDISP,ACMDONE,ACMHIGH,ACMI,ACMJOB,ACMQMAN,ACMSEL,ACMTEXT,ACMVAR,ACMSKIP,ACMPRNT,ACMPRNM,ACMLINE,ACMRCNT,ACMSCNT,ACMDFET,ACMY,DFN
+2 KILL X,X1,X2,IO("Q"),%,Y,POP,DIRUT,ZTSK,ZTQUEUED,H,S,TS,M,ZTIO,DUOUT,DIR,DTOUT,V,Z,I,DIC,DIK,DIADD,DLAYGO,DA,DR,DIE,DIU,AMQQTAX,DINUM,ACMPACK,ACMEP1,ACMEP2,D,ACMLENG,ACMLHDR,ACMSAVE
+3 QUIT
