APCLVLP2.m

APCLVLP2 ; IHS/CMI/LAB - PRINT VISIT REPORT ;

 ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 ;

DONE ;EP

 I $D(ZTQUEUED),APCLCTYP="F" G DONE1

 D DONE^APCLOSUT

DONE1 ;

 K ^XTMP("APCLVL",APCLJOB,APCLBT),^XTMP("APCLFLAT",$J)

 D DEL^APCLVL

 K APCLBD,APCLSD,APCLED,APCLEDD,APCLBDD,APCLRPT,APCLHEAD,APCLLINE,APCLL,APCLRCNT,APCLI,APCLCRIT,APCLVIEN,APCLVREC,APCLJOB,APCLBT,APCLBTH,APCLQUIT,APCLHDR,APCLDASH,APCLLENG,APCLPCNT,APCLTCW,APCLODAT,APCLPG,AUPNDAYS,AUPNPAT,AUPNDOD,AUPNDOB,AUPNSEX

 K APCLSORT,APCLSRT,APCLSORX,APCLFILE,APCLFIEL,APCLPRNT,APCLX,APCLTYPE,APCLFOUN,D0,J,K,L,APCLPRNM,APCLTEST,APCLSEAT,APCLLHDR,APCLFRST

 Q

HEAD ;ENTRY POINT

 I 'APCLPG 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 APCLQUIT="" Q

HEAD1 ;EP

 I APCLCTYP="F",$D(ZTQUEUED) Q

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

 I $G(APCLTITL)="" S APCLTEXT="PCC "_$S(APCLPTVS="V":"VISIT",1:"PATIENT")_" LISTING",APCLLENG=$L(APCLTEXT) W !?((APCLTCW-APCLLENG)/2),APCLTEXT,?(APCLTCW-8),"Page ",APCLPG

 I $G(APCLTITL)]"" S APCLLENG=$L(APCLTITL) W !?((APCLTCW-APCLLENG)/2),APCLTITL,?(APCLTCW-8),"Page ",APCLPG

 I APCLTYPE="D" S APCLLENG=46 S:APCLTCW<APCLLENG APCLLENG=APCLTCW W !?((APCLTCW-APCLLENG)/2),"Visit Dates:  ",APCLBDD," and ",APCLEDD,!

 I APCLTYPE="S" S APCLLENG=16+$L($P(^DIBT(APCLSEAT,0),U)) S:APCLTCW<APCLLENG APCLLENG=APCLTCW  W !?((APCLTCW-APCLLENG)/2),"Search Template: ",$P(^DIBT(APCLSEAT,0),U),!

 I APCLCTYP="S" S APCLLENG=$L(APCLSORV)+23 W !?((APCLTCW-APCLLENG)/2),$S(APCLPTVS="V":"VISIT",1:"PATIENT")," SUB-TOTALS BY:  ",APCLSORV,!

 I $G(APCLSPAG) S APCLLENG=$L(APCLSORV)+$L(APCLSRTR)+2 S:APCLTCW<APCLLENG APCLLENG=APCLTCW W !?((APCLTCW-APCLLENG)/2),APCLSORV,":  ",APCLSRTR,!

 I APCLHEAD]"" W !,APCLHEAD,!

 W APCLDASH,!

 I APCLCTYP="S" W !,APCLSORV,":"

 I APCLCTYP="F",$E(IOST)="C" W !!,"Flat file being created, hold on...",!

 Q

WRITEF ;EP - write out flat file

 S XBGL="XTMP("_$J_",""APCLFLAT"","

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

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

 D ^XBGSAVE

 ;check for error

 K ^XTMP($J,"APCLFLAT")

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

 Q

APCLVLP2  ; IHS/CMI/LAB - PRINT VISIT REPORT ;

 +1       ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 +2       ;

DONE      ;EP

 +1        IF $DATA(ZTQUEUED)

               IF APCLCTYP="F"

                   GOTO DONE1

 +2        DO DONE^APCLOSUT

DONE1     ;

 +1        KILL ^XTMP("APCLVL",APCLJOB,APCLBT),^XTMP("APCLFLAT",$JOB)

 +2        DO DEL^APCLVL

 +3        KILL APCLBD,APCLSD,APCLED,APCLEDD,APCLBDD,APCLRPT,APCLHEAD,APCLLINE,APCLL,APCLRCNT,APCLI,APCLCRIT,APCLVIEN,APCLVREC,APCLJOB,APCLBT,APCLBTH,APCLQUIT,APCLHDR,APCLDASH,APCLLENG,APCLPCNT,APCLTCW,APCLODAT,APCLPG,AUPNDAYS,AUPNPAT,AUPNDOD,AUPNDOB,AUPN

SEX

 +4        KILL APCLSORT,APCLSRT,APCLSORX,APCLFILE,APCLFIEL,APCLPRNT,APCLX,APCLTYPE,APCLFOUN,D0,J,K,L,APCLPRNM,APCLTEST,APCLSEAT,APCLLHDR,APCLFRST

 +5        QUIT 

HEAD      ;ENTRY POINT

 +1        IF 'APCLPG

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

                       QUIT 

HEAD1     ;EP

 +1        IF APCLCTYP="F"

               IF $DATA(ZTQUEUED)

                   QUIT 

 +2        IF $DATA(IOF)

               WRITE @IOF

           SET APCLPG=APCLPG+1

 +3        IF $GET(APCLTITL)=""

               SET APCLTEXT="PCC "_$SELECT(APCLPTVS="V":"VISIT",1:"PATIENT")_" LISTING"

               SET APCLLENG=$LENGTH(APCLTEXT)

               WRITE !?((APCLTCW-APCLLENG)/2),APCLTEXT,?(APCLTCW-8),"Page ",APCLPG

 +4        IF $GET(APCLTITL)]""

               SET APCLLENG=$LENGTH(APCLTITL)

               WRITE !?((APCLTCW-APCLLENG)/2),APCLTITL,?(APCLTCW-8),"Page ",APCLPG

 +5        IF APCLTYPE="D"

               SET APCLLENG=46

               IF APCLTCW<APCLLENG

                   SET APCLLENG=APCLTCW

               WRITE !?((APCLTCW-APCLLENG)/2),"Visit Dates:  ",APCLBDD," and ",APCLEDD,!

 +6        IF APCLTYPE="S"

               SET APCLLENG=16+$LENGTH($PIECE(^DIBT(APCLSEAT,0),U))

               IF APCLTCW<APCLLENG

                   SET APCLLENG=APCLTCW

               WRITE !?((APCLTCW-APCLLENG)/2),"Search Template: ",$PIECE(^DIBT(APCLSEAT,0),U),!

 +7        IF APCLCTYP="S"

               SET APCLLENG=$LENGTH(APCLSORV)+23

               WRITE !?((APCLTCW-APCLLENG)/2),$SELECT(APCLPTVS="V":"VISIT",1:"PATIENT")," SUB-TOTALS BY:  ",APCLSORV,!

 +8        IF $GET(APCLSPAG)

               SET APCLLENG=$LENGTH(APCLSORV)+$LENGTH(APCLSRTR)+2

               IF APCLTCW<APCLLENG

                   SET APCLLENG=APCLTCW

               WRITE !?((APCLTCW-APCLLENG)/2),APCLSORV,":  ",APCLSRTR,!

 +9        IF APCLHEAD]""

               WRITE !,APCLHEAD,!

 +10       WRITE APCLDASH,!

 +11       IF APCLCTYP="S"

               WRITE !,APCLSORV,":"

 +12       IF APCLCTYP="F"

               IF $EXTRACT(IOST)="C"

                   WRITE !!,"Flat file being created, hold on...",!

 +13       QUIT 

WRITEF    ;EP - write out flat file

 +1        SET XBGL="XTMP("_$JOB_",""APCLFLAT"","

 +2        SET XBMED="F"

           SET XBFN=APCLOUTF

           SET XBTLE="SAVE OF VGEN/PGEN 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 ^XTMP($JOB,"APCLFLAT")

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

 +8        QUIT