ACMRLP1 ; IHS/TUCSON/TMJ - CONT OF ACMRLP ; [ 06/01/1999 1:41 PM ]
;;2.0;ACM CASE MANAGEMENT SYSTEM;**1**;JAN 10, 1996
;IHS/CMI/LAB - tmp to xtmp
;
;
COVPAGE ;EP
W:$D(IOF) @IOF
W !?20,"CASE MANAGEMENT PATIENT REGISTER ",$S(ACMCTYP="D":"LISTING",1:"COUNT")
W !!,"REPORT REQUESTED BY: ",$P(^VA(200,DUZ,0),U)
W !!,"REGISTER: ",$P(^ACM(41.1,ACMRG,0),U)
W !!,"The following report contains a CONFIDENTIAL Patient report based on the",!,"following criteria:",!
SHOW ;
W !,"PATIENT Selection Criteria"
I '$D(^ACM(58.8,ACMRPT,11)) G SHOWP
S ACMI=0 F S ACMI=$O(^ACM(58.8,ACMRPT,11,ACMI)) Q:ACMI'=+ACMI D
.I $Y>(IOSL-5) D PAUSE^ACMRL01 W @IOF
.W !?6,$P(^ACM(58.1,ACMI,0),U),": "
.K ACMQ S ACMY=0,C=0 K ACMQ F S ACMY=$O(^ACM(58.8,ACMRPT,11,ACMI,11,"B",ACMY)) S C=C+1 W:C'=1&(ACMY'="") " ; " Q:ACMY=""!($D(ACMQ)) S X=ACMY X:$D(^ACM(58.1,ACMI,2)) ^(2) W X
K ACMQ
SHOWP ;
I ACMCTYP="T" D COUNT Q
I ACMCTYP="S" D I 1
.I $Y>(IOSL-6) D PAUSE^ACMRL01 W @IOF
.W !!,"Report will contain sub-totals by ",$P(^ACM(58.1,ACMSORT,0),U),"."
.I '$D(^XTMP("ACMRL",ACMJOB,ACMBTH)) W !!,"NO DATA TO REPORT.",! D PAUSE^ACMRL01 W:$D(IOF) @IOF
.Q
I ACMCTYP'="D" D PAUSE^ACMRL01 W:$D(IOF) @IOF Q
I $Y>(IOSL-4) D PAUSE^ACMRL01 W @IOF
W !!,"PRINT Field Selection"
I '$D(^ACM(58.8,ACMRPT,12)) G PAUSE
S ACMI=0 F S ACMI=$O(^ACM(58.8,ACMRPT,12,ACMI)) Q:ACMI'=+ACMI S ACMCRIT=$P(^ACM(58.8,ACMRPT,12,ACMI,0),U) D
.I $Y>(IOSL-4) D PAUSE^ACMRL01 W:$D(IOF) @IOF
.W !?6,$P(^ACM(58.1,ACMCRIT,0),U)," (" S X=$O(^ACM(58.8,ACMRPT,12,"B",ACMCRIT,"")) W $P(^ACM(58.8,ACMRPT,12,X,0),U,2),")"
I $Y>(IOSL-4) D PAUSE^ACMRL01 W:$D(IOF) @IOF
W !?10," TOTAL column width: ",ACMTCW
Q:'$G(ACMSORT)
I $Y>(IOSL-4) D PAUSE^ACMRL01 W:$D(IOF) @IOF
W !!,"Patients will be SORTED by: ",$P(^ACM(58.1,ACMSORT,0),U),!
I $Y>(IOSL-4) D PAUSE^ACMRL01 W:$D(IOF) @IOF
I $G(ACMSPAG) W !?6,"Each ",$P(^ACM(58.1,ACMSORT,0),U)," will be on a separate page.",!
I '$D(^XTMP("ACMRL",ACMJOB,ACMBTH)) W !!,"NO DATA TO REPORT.",!
PAUSE D PAUSE^ACMRL01 W:$D(IOF) @IOF
Q
COUNT ;if COUNTING entries only
I $Y>(IOSL-5) D PAUSE^ACMRL01 W:$D(IOF) @IOF
I '$D(^XTMP("ACMRL",ACMJOB,ACMBTH)) W !!!,"NO DATA TO REPORT.",!
W:$D(ACMRCNT) !!!,"Total COUNT of PATIENTS: ",ACMRCNT
Q
WP ;EP - Entry point to print wp fields pass node in ACMNODE
;PASS FILE IN ACMFILE, ENTRY IN ACMDA
K ^UTILITY($J,"W")
S ACMRLX=0
S ACMG1=^DIC(ACMFILE,0,"GL"),ACMG=ACMG1_ACMDA_","_ACMNODE_",ACMRLX)",ACMGR=ACMG1_ACMDA_","_ACMNODE_",ACMRLX"
S DIWL=1,DIWR=$P(^ACM(58.8,ACMRPT,12,ACMI,0),U,2) F S ACMRLX=$O(@ACMG) Q:ACMRLX'=+ACMRLX D
.S Y=ACMGR_",0)" S X=@Y D ^DIWP
.Q
S Z=0 F S Z=$O(^UTILITY($J,"W",DIWL,Z)) Q:Z'=+Z S ACMPCNT=ACMPCNT+1,ACMPRNM(ACMPCNT)=^UTILITY($J,"W",DIWL,Z,0)
S ACMPCNT=ACMPCNT+1
K DIWL,DIWR,DIWF,Z
K ^UTILITY($J,"W"),ACMNODE,ACMFILE,ACMDA,ACMG1,ACMGR,ACMRLX
Q
ACMRLP1 ; IHS/TUCSON/TMJ - CONT OF ACMRLP ; [ 06/01/1999 1:41 PM ]
+1 ;;2.0;ACM CASE MANAGEMENT SYSTEM;**1**;JAN 10, 1996
+2 ;IHS/CMI/LAB - tmp to xtmp
+3 ;
+4 ;
COVPAGE ;EP
+1 IF $DATA(IOF)
WRITE @IOF
+2 WRITE !?20,"CASE MANAGEMENT PATIENT REGISTER ",$SELECT(ACMCTYP="D":"LISTING",1:"COUNT")
+3 WRITE !!,"REPORT REQUESTED BY: ",$PIECE(^VA(200,DUZ,0),U)
+4 WRITE !!,"REGISTER: ",$PIECE(^ACM(41.1,ACMRG,0),U)
+5 WRITE !!,"The following report contains a CONFIDENTIAL Patient report based on the",!,"following criteria:",!
SHOW ;
+1 WRITE !,"PATIENT Selection Criteria"
+2 IF '$DATA(^ACM(58.8,ACMRPT,11))
GOTO SHOWP
+3 SET ACMI=0
FOR
SET ACMI=$ORDER(^ACM(58.8,ACMRPT,11,ACMI))
IF ACMI'=+ACMI
QUIT
Begin DoDot:1
+4 IF $Y>(IOSL-5)
DO PAUSE^ACMRL01
WRITE @IOF
+5 WRITE !?6,$PIECE(^ACM(58.1,ACMI,0),U),": "
+6 KILL ACMQ
SET ACMY=0
SET C=0
KILL ACMQ
FOR
SET ACMY=$ORDER(^ACM(58.8,ACMRPT,11,ACMI,11,"B",ACMY))
SET C=C+1
IF C'=1&(ACMY'="")
WRITE " ; "
IF ACMY=""!($DATA(ACMQ))
QUIT
SET X=ACMY
IF $DATA(^ACM(58.1,ACMI,2))
XECUTE ^(2)
WRITE X
End DoDot:1
+7 KILL ACMQ
SHOWP ;
+1 IF ACMCTYP="T"
DO COUNT
QUIT
+2 IF ACMCTYP="S"
Begin DoDot:1
+3 IF $Y>(IOSL-6)
DO PAUSE^ACMRL01
WRITE @IOF
+4 WRITE !!,"Report will contain sub-totals by ",$PIECE(^ACM(58.1,ACMSORT,0),U),"."
+5 IF '$DATA(^XTMP("ACMRL",ACMJOB,ACMBTH))
WRITE !!,"NO DATA TO REPORT.",!
DO PAUSE^ACMRL01
IF $DATA(IOF)
WRITE @IOF
+6 QUIT
End DoDot:1
IF 1
+7 IF ACMCTYP'="D"
DO PAUSE^ACMRL01
IF $DATA(IOF)
WRITE @IOF
QUIT
+8 IF $Y>(IOSL-4)
DO PAUSE^ACMRL01
WRITE @IOF
+9 WRITE !!,"PRINT Field Selection"
+10 IF '$DATA(^ACM(58.8,ACMRPT,12))
GOTO PAUSE
+11 SET ACMI=0
FOR
SET ACMI=$ORDER(^ACM(58.8,ACMRPT,12,ACMI))
IF ACMI'=+ACMI
QUIT
SET ACMCRIT=$PIECE(^ACM(58.8,ACMRPT,12,ACMI,0),U)
Begin DoDot:1
+12 IF $Y>(IOSL-4)
DO PAUSE^ACMRL01
IF $DATA(IOF)
WRITE @IOF
+13 WRITE !?6,$PIECE(^ACM(58.1,ACMCRIT,0),U)," ("
SET X=$ORDER(^ACM(58.8,ACMRPT,12,"B",ACMCRIT,""))
WRITE $PIECE(^ACM(58.8,ACMRPT,12,X,0),U,2),")"
End DoDot:1
+14 IF $Y>(IOSL-4)
DO PAUSE^ACMRL01
IF $DATA(IOF)
WRITE @IOF
+15 WRITE !?10," TOTAL column width: ",ACMTCW
+16 IF '$GET(ACMSORT)
QUIT
+17 IF $Y>(IOSL-4)
DO PAUSE^ACMRL01
IF $DATA(IOF)
WRITE @IOF
+18 WRITE !!,"Patients will be SORTED by: ",$PIECE(^ACM(58.1,ACMSORT,0),U),!
+19 IF $Y>(IOSL-4)
DO PAUSE^ACMRL01
IF $DATA(IOF)
WRITE @IOF
+20 IF $GET(ACMSPAG)
WRITE !?6,"Each ",$PIECE(^ACM(58.1,ACMSORT,0),U)," will be on a separate page.",!
+21 IF '$DATA(^XTMP("ACMRL",ACMJOB,ACMBTH))
WRITE !!,"NO DATA TO REPORT.",!
PAUSE DO PAUSE^ACMRL01
IF $DATA(IOF)
WRITE @IOF
+1 QUIT
COUNT ;if COUNTING entries only
+1 IF $Y>(IOSL-5)
DO PAUSE^ACMRL01
IF $DATA(IOF)
WRITE @IOF
+2 IF '$DATA(^XTMP("ACMRL",ACMJOB,ACMBTH))
WRITE !!!,"NO DATA TO REPORT.",!
+3 IF $DATA(ACMRCNT)
WRITE !!!,"Total COUNT of PATIENTS: ",ACMRCNT
+4 QUIT
WP ;EP - Entry point to print wp fields pass node in ACMNODE
+1 ;PASS FILE IN ACMFILE, ENTRY IN ACMDA
+2 KILL ^UTILITY($JOB,"W")
+3 SET ACMRLX=0
+4 SET ACMG1=^DIC(ACMFILE,0,"GL")
SET ACMG=ACMG1_ACMDA_","_ACMNODE_",ACMRLX)"
SET ACMGR=ACMG1_ACMDA_","_ACMNODE_",ACMRLX"
+5 SET DIWL=1
SET DIWR=$PIECE(^ACM(58.8,ACMRPT,12,ACMI,0),U,2)
FOR
SET ACMRLX=$ORDER(@ACMG)
IF ACMRLX'=+ACMRLX
QUIT
Begin DoDot:1
+6 SET Y=ACMGR_",0)"
SET X=@Y
DO ^DIWP
+7 QUIT
End DoDot:1
+8 SET Z=0
FOR
SET Z=$ORDER(^UTILITY($JOB,"W",DIWL,Z))
IF Z'=+Z
QUIT
SET ACMPCNT=ACMPCNT+1
SET ACMPRNM(ACMPCNT)=^UTILITY($JOB,"W",DIWL,Z,0)
+9 SET ACMPCNT=ACMPCNT+1
+10 KILL DIWL,DIWR,DIWF,Z
+11 KILL ^UTILITY($JOB,"W"),ACMNODE,ACMFILE,ACMDA,ACMG1,ACMGR,ACMRLX
+12 QUIT
