- 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
