ACDRLP2.m

ACDRLP2 ;IHS/ADC/EDE/KML - PRINT GEN RET;

 ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998

 ;

DONE ;EP

 D:ACDCTYP'="F" DONE^ACDRLU1

 K ^TMP("ACDRL",ACDJOB,ACDBT)

 D DEL^ACDRL

 K ACDBD,ACDSD,ACDED,ACDEDD,ACDBDD,ACDRPT,ACDHEAD,ACDLINE,ACDL,ACDRCNT,ACDI,ACDCRIT,ACDR,ACDRREC,ACDJOB,ACDBT,ACDBTH,ACDQUIT,ACDHDR,ACDDASH,ACDLENG,ACDPCNT,ACDTCW,ACDODAT,ACDPG,AUPNDAYS,AUPNPAT,AUPNDOD,AUPNDOB,AUPNSEX

 K ACDSORT,ACDSRT,ACDSORX,ACDFILE,ACDFIEL,ACDPRNT,ACDX,ACDFOUN,D0,J,K,L,ACDPRNM,ACDTEST,ACDLHDR,ACDFRST

 Q

HEAD ;ENTRY POINT

 I 'ACDPG 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 ACDQUIT="" Q

HEAD1 ;EP

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

 W !?13,"********** CONFIDENTIAL PATIENT INFORMATION **********"

 I $G(ACDTITL)="" S ACDTEXT="CDMIS "_$S(ACDPTVS="V":"VISIT",1:"PATIENT")_" LISTING",ACDLENG=$L(ACDTEXT) W !?(($S(ACDTCW<81:80,1:ACDTCW)-ACDLENG)/2),ACDTEXT,?($S(ACDTCW<81:80,1:ACDTCW)-8),"Page ",ACDPG

 I $G(ACDTITL)]"" S ACDLENG=$L(ACDTITL) W !?(($S(ACDTCW<81:80,1:ACDTCW)-ACDLENG)/2),ACDTITL,?($S(ACDTCW<81:80,1:ACDTCW)-8),"Page ",ACDPG

 I ACDPTVS="V" S ACDLENG=46 S:$S(ACDTCW<81:80,1:ACDTCW)<ACDLENG ACDLENG=$S(ACDTCW<81:80,1:ACDTCW) W !?(($S(ACDTCW<81:80,1:ACDTCW)-ACDLENG)/2),"Record Dates:  ",ACDBDD," and ",ACDEDD,!

 I ACDCTYP="S" S ACDLENG=$L(ACDSORV)+23 W !?(($S(ACDTCW<81:80,1:ACDTCW)-ACDLENG)/2),$S(ACDPTVS="V":"VISIT",1:"PATIENT")," SUB-TOTALS BY:  ",ACDSORV,!

 I $G(ACDSPAG) S ACDLENG=$L(ACDSRTR)+$L(ACDSORV)+2 S:$S(ACDTCW<81:80,1:ACDTCW)<ACDLENG ACDLENG=$S(ACDTCW<81:80,1:ACDTCW) W !?(($S(ACDTCW<81:80,1:ACDTCW)-ACDLENG)/2),ACDSORV,":  ",ACDSRTR,!

 I ACDHEAD]"" W !,ACDHEAD,!

 W ACDDASH,!

 I ACDCTYP="S" W !,ACDSORV,":"

 Q

WRITEF ;EP - write out flat file

 S XBGL="TMP("_$J_",""ACDFLAT"","

 S XBMED="F",XBFN=ACDFILE,XBTLE="SAVE OF CDMIS RECORDS GENERATED BY -"_$P(^VA(200,DUZ,0),U)

 S XBF=0,XBQ="N",XBFLT=1,XBE=$J

 D ^XBGSAVE

 ;check for error

 K ^TMP($J,"ACDFLAT")

 K XBGL,XBMED,XBTLE,XBFN,XBF,XBQ,XBFLT

 Q

ACDRLP2   ;IHS/ADC/EDE/KML - PRINT GEN RET;

 +1       ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998

 +2       ;

DONE      ;EP

 +1        IF ACDCTYP'="F"

               DO DONE^ACDRLU1

 +2        KILL ^TMP("ACDRL",ACDJOB,ACDBT)

 +3        DO DEL^ACDRL

 +4        KILL ACDBD,ACDSD,ACDED,ACDEDD,ACDBDD,ACDRPT,ACDHEAD,ACDLINE,ACDL,ACDRCNT,ACDI,ACDCRIT,ACDR,ACDRREC,ACDJOB,ACDBT,ACDBTH,ACDQUIT,ACDHDR,ACDDASH,ACDLENG,ACDPCNT,ACDTCW,ACDODAT,ACDPG,AUPNDAYS,AUPNPAT,AUPNDOD,AUPNDOB,AUPNSEX

 +5        KILL ACDSORT,ACDSRT,ACDSORX,ACDFILE,ACDFIEL,ACDPRNT,ACDX,ACDFOUN,D0,J,K,L,ACDPRNM,ACDTEST,ACDLHDR,ACDFRST

 +6        QUIT 

HEAD      ;ENTRY POINT

 +1        IF 'ACDPG

               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 ACDQUIT=""

                       QUIT 

HEAD1     ;EP

 +1        IF $DATA(IOF)

               WRITE @IOF

           SET ACDPG=ACDPG+1

 +2        WRITE !?13,"********** CONFIDENTIAL PATIENT INFORMATION **********"

 +3        IF $GET(ACDTITL)=""

               SET ACDTEXT="CDMIS "_$SELECT(ACDPTVS="V":"VISIT",1:"PATIENT")_" LISTING"

               SET ACDLENG=$LENGTH(ACDTEXT)

               WRITE !?(($SELECT(ACDTCW<81:80,1:ACDTCW)-ACDLENG)/2),ACDTEXT,?($SELECT(ACDTCW<81:80,1:ACDTCW)-8),"Page ",ACDPG

 +4        IF $GET(ACDTITL)]""

               SET ACDLENG=$LENGTH(ACDTITL)

               WRITE !?(($SELECT(ACDTCW<81:80,1:ACDTCW)-ACDLENG)/2),ACDTITL,?($SELECT(ACDTCW<81:80,1:ACDTCW)-8),"Page ",ACDPG

 +5        IF ACDPTVS="V"

               SET ACDLENG=46

               IF $SELECT(ACDTCW<81

                   SET ACDLENG=$SELECT(ACDTCW<81:80,1:ACDTCW)

               WRITE !?(($SELECT(ACDTCW<81:80,1:ACDTCW)-ACDLENG)/2),"Record Dates:  ",ACDBDD," and ",ACDEDD,!

 +6        IF ACDCTYP="S"

               SET ACDLENG=$LENGTH(ACDSORV)+23

               WRITE !?(($SELECT(ACDTCW<81:80,1:ACDTCW)-ACDLENG)/2),$SELECT(ACDPTVS="V":"VISIT",1:"PATIENT")," SUB-TOTALS BY:  ",ACDSORV,!

 +7        IF $GET(ACDSPAG)

               SET ACDLENG=$LENGTH(ACDSRTR)+$LENGTH(ACDSORV)+2

               IF $SELECT(ACDTCW<81

                   SET ACDLENG=$SELECT(ACDTCW<81:80,1:ACDTCW)

               WRITE !?(($SELECT(ACDTCW<81:80,1:ACDTCW)-ACDLENG)/2),ACDSORV,":  ",ACDSRTR,!

 +8        IF ACDHEAD]""

               WRITE !,ACDHEAD,!

 +9        WRITE ACDDASH,!

 +10       IF ACDCTYP="S"

               WRITE !,ACDSORV,":"

 +11       QUIT 

WRITEF    ;EP - write out flat file

 +1        SET XBGL="TMP("_$JOB_",""ACDFLAT"","

 +2        SET XBMED="F"

           SET XBFN=ACDFILE

           SET XBTLE="SAVE OF CDMIS RECORDS GENERATED BY -"_$PIECE(^VA(200,DUZ,0),U)

 +3        SET XBF=0

           SET XBQ="N"

           SET XBFLT=1

           SET XBE=$JOB

 +4        DO ^XBGSAVE

 +5       ;check for error

 +6        KILL ^TMP($JOB,"ACDFLAT")

 +7        KILL XBGL,XBMED,XBTLE,XBFN,XBF,XBQ,XBFLT

 +8        QUIT