ACMRLP2.m

ACMRLP2 ; IHS/TUCSON/TMJ - PRINT LISTER REPORT ; [ 06/01/1999  1:42 PM ]

 ;;2.0;ACM CASE MANAGEMENT SYSTEM;**1**;JAN 10, 1996

 ;

 ;IHS/CMI/LAB - tmp to xtmp

DONE ;EP

 I ACMCTYP'="F" D DONE^ACMRL ;IHS/CMI/LAB

 K ^XTMP("ACMRL",ACMJOB,ACMBT)

 D DEL^ACMRL

 K ACMBD,ACMSD,ACMED,ACMEDD,ACMBDD,ACMRPT,ACMHEAD,ACMLINE,ACML,ACMRCNT,ACMI,ACMCRIT,ACMVIEN,ACMVREC,ACMJOB,ACMBT,ACMBTH,ACMQUIT,ACMHDR,ACMDASH,ACMLENG,ACMPCNT,ACMTCW,ACMODAT,ACMPG,AUPNDAYS,AUPNPAT,AUPNDOD,AUPNDOB,AUPNSEX

 K ACMSORT,ACMSRT,ACMSORX,ACMFILE,ACMFIEL,ACMPRNT,ACMX,ACMFOUN,D0,J,K,L,ACMPRNM,ACMTEST,ACMSEAT,ACMLHDR,ACMFRST,ACMFFN

 Q

HEAD ;ENTRY POINT

 I 'ACMPG G HEAD1

 I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S ACMQUIT="" Q

HEAD1 ;EP

 W:$D(IOF) @IOF S ACMPG=ACMPG+1

 I $G(ACMTITL)="" S ACMTEXT="CASE MANAGEMENT PATIENT LISTING",ACMLENG=$L(ACMTEXT) W !?((ACMTCW-ACMLENG)/2),ACMTEXT,?(ACMTCW-8),"Page ",ACMPG

 S ACMTEXT=$P(^ACM(41.1,ACMRG,0),U)_" REGISTER",ACMLENG=$L(ACMTEXT) W !?(($S(ACMTCW>80:80,1:ACMTCW)-ACMLENG)/2),ACMTEXT

 I $G(ACMTITL)]"" S ACMLENG=$L(ACMTITL) W !?((ACMTCW-ACMLENG)/2),ACMTITL,?(ACMTCW-8),"Page ",ACMPG

 I ACMCTYP="S" S ACMLENG=$L(ACMSORV)+23 W !?((ACMTCW-ACMLENG)/2)," PATIENT SUB-TOTALS BY:  ",ACMSORV,!

 I $G(ACMSPAG) S ACMLENG=$L(ACMSORV)+$L(ACMSRTR)+2 S:ACMTCW<ACMLENG ACMLENG=ACMTCW W !?((ACMTCW-ACMLENG)/2),ACMSORV,":  ",ACMSRTR,!

 I ACMHEAD]"" W !,ACMHEAD,!

 W ACMDASH,!

 I ACMCTYP="S" W !,ACMSORV,":"

 Q

ACMRLP2   ; IHS/TUCSON/TMJ - PRINT LISTER REPORT ; [ 06/01/1999  1:42 PM ]

 +1       ;;2.0;ACM CASE MANAGEMENT SYSTEM;**1**;JAN 10, 1996

 +2       ;

 +3       ;IHS/CMI/LAB - tmp to xtmp

DONE      ;EP

 +1       ;IHS/CMI/LAB

           IF ACMCTYP'="F"

               DO DONE^ACMRL

 +2        KILL ^XTMP("ACMRL",ACMJOB,ACMBT)

 +3        DO DEL^ACMRL

 +4        KILL ACMBD,ACMSD,ACMED,ACMEDD,ACMBDD,ACMRPT,ACMHEAD,ACMLINE,ACML,ACMRCNT,ACMI,ACMCRIT,ACMVIEN,ACMVREC,ACMJOB,ACMBT,ACMBTH,ACMQUIT,ACMHDR,ACMDASH,ACMLENG,ACMPCNT,ACMTCW,ACMODAT,ACMPG,AUPNDAYS,AUPNPAT,AUPNDOD,AUPNDOB,AUPNSEX

 +5        KILL ACMSORT,ACMSRT,ACMSORX,ACMFILE,ACMFIEL,ACMPRNT,ACMX,ACMFOUN,D0,J,K,L,ACMPRNM,ACMTEST,ACMSEAT,ACMLHDR,ACMFRST,ACMFFN

 +6        QUIT 

HEAD      ;ENTRY POINT

 +1        IF 'ACMPG

               GOTO HEAD1

 +2        IF $EXTRACT(IOST)="C"

               IF IO=IO(0)

                   WRITE !

                   SET DIR(0)="EO"

                   DO ^DIR

                   KILL DIR

                   IF Y=0!(Y="^")!($DATA(DTOUT))

                       SET ACMQUIT=""

                       QUIT 

HEAD1     ;EP

 +1        IF $DATA(IOF)

               WRITE @IOF

           SET ACMPG=ACMPG+1

 +2        IF $GET(ACMTITL)=""

               SET ACMTEXT="CASE MANAGEMENT PATIENT LISTING"

               SET ACMLENG=$LENGTH(ACMTEXT)

               WRITE !?((ACMTCW-ACMLENG)/2),ACMTEXT,?(ACMTCW-8),"Page ",ACMPG

 +3        SET ACMTEXT=$PIECE(^ACM(41.1,ACMRG,0),U)_" REGISTER"

           SET ACMLENG=$LENGTH(ACMTEXT)

           WRITE !?(($SELECT(ACMTCW>80:80,1:ACMTCW)-ACMLENG)/2),ACMTEXT

 +4        IF $GET(ACMTITL)]""

               SET ACMLENG=$LENGTH(ACMTITL)

               WRITE !?((ACMTCW-ACMLENG)/2),ACMTITL,?(ACMTCW-8),"Page ",ACMPG

 +5        IF ACMCTYP="S"

               SET ACMLENG=$LENGTH(ACMSORV)+23

               WRITE !?((ACMTCW-ACMLENG)/2)," PATIENT SUB-TOTALS BY:  ",ACMSORV,!

 +6        IF $GET(ACMSPAG)

               SET ACMLENG=$LENGTH(ACMSORV)+$LENGTH(ACMSRTR)+2

               IF ACMTCW<ACMLENG

                   SET ACMLENG=ACMTCW

               WRITE !?((ACMTCW-ACMLENG)/2),ACMSORV,":  ",ACMSRTR,!

 +7        IF ACMHEAD]""

               WRITE !,ACMHEAD,!

 +8        WRITE ACMDASH,!

 +9        IF ACMCTYP="S"

               WRITE !,ACMSORV,":"

 +10       QUIT