APCL8AP.m

APCL8AP ; IHS/CMI/LAB - print apc report 1A ;

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

START ;

 S APCL80="-----------------------------------------------------------------------------"

 S Y=$E(APCLFYE,1,3)_"0000" D DD^%DT S APCLFYD=Y S Y=DT D DD^%DT S APCLDT=Y

 S APCLLOCC=$P(^AUTTLOC(APCLLOC,0),U,10),APCLLOCP=$P(^DIC(4,APCLLOC,0),U)

 S APCLAREA=$P(^AUTTLOC(APCLLOC,0),U,4) I APCLAREA="" S (APCLAREA,APCLAREC)="???" G SU

 I '$D(^AUTTAREA(APCLAREA,0)) S (APCLAREA,APCLAREC)="???" G SU

 S APCLAREC=$P(^AUTTAREA(APCLAREA,0),U,2),APCLAREA=$P(^AUTTAREA(APCLAREA,0),U)

SU ;

 S APCLSU=$P(^AUTTLOC(APCLLOC,0),U,5) I APCLSU="" S (APCLSU,APCLSUC)="???" G START2

 I '$D(^AUTTSU(APCLSU,0)) S (APCLSU,APCLSUC)="999" G START2

 S APCLSUC=$P(^AUTTSU(APCLSU,0),U,3),APCLSU=$P(^AUTTSU(APCLSU,0),U)

START2 S (APCLPG,APCLVDFN,APCLPRIT)=0 D HEAD

 K APCLQUIT

 F  S APCLVDFN=$O(^XTMP("APCL8A",APCLJOB,APCLBT,"VISITS",APCLVDFN)) Q:APCLVDFN=""!($D(APCLQUIT))  D P

 ;I $D(^XTMP("APCL8A",APCLJOB,APCLBT,"NO EXPORT")) D  I 1

 W !

DONE D DONE^APCLOSUT

 K ^XTMP("APCL8A",APCLJOB,APCLBT)

 Q

FIRSTPG ;

 W !,"Total Number of APC visits counted:  ",APCLGRAN

 W !,"Total Number of those APC Visits NOT Exported:  ",$S($D(^XTMP("APCL8A",APCLJOB,APCLBT,"NO EXPORT")):^("NO EXPORT"),1:0)

 W !!,"Of the total number of visits counted in the 1A, but NOT exported to the",!,"National Data Warehouse, ",$S($D(^XTMP("APCL8A",APCLJOB,APCLBT,"IN XREF")):^("IN XREF"),1:0)

 W " were not exported because they were posted ",!,"or modified after the last NDW export tape was generated.",!

 I '$D(^XTMP("APCL8A",APCLJOB,APCLBT,"VISITS")) S APCLQUIT=1 Q

 W !,"The remaining ",($S($D(^XTMP("APCL8A",APCLJOB,APCLBT,"NO EXPORT")):^("NO EXPORT"),1:0)-$S($D(^XTMP("APCL8A",APCLJOB,APCLBT,"IN XREF")):^("IN XREF"),1:0))," visits are listed below.",!

 Q

P ;

 ;S DA=APCLVDFN,DIE="^AUPNVSIT(",DR=".13///^S X=DT" D ^DIE D ^XBFMK

 I $Y>(IOSL-5) D HEAD Q:$D(APCLQUIT)

 S APCLVREC=^AUPNVSIT(APCLVDFN,0),APCLVLOC=$P(APCLVREC,U,6),APCLTYPE=$P(APCLVREC,U,3),APCLSC=$P(APCLVREC,U,7)

 S DFN=$P(APCLVREC,U,5),APCLHRN="" S:$D(^AUPNPAT(DFN,41,APCLVLOC,0)) APCLHRN=$P(^AUPNPAT(DFN,41,APCLVLOC,0),U,2)

 S:APCLHRN="" APCLHRN=$P($G(^AUPNPAT(DFN,41,DUZ(2),0)),U,2)

CLINIC ;

 S APCLCLN=$P(^AUPNVSIT(APCLVDFN,0),U,8) I APCLCLN="" S APCLCLN="--" G VD

 S APCLCLN=$P(^DIC(40.7,APCLCLN,0),U,2)

VD ;

 S Y=+APCLVREC X ^DD("DD") S APCLRD=Y

PRN ;

 W !,APCLHRN,?8,APCLRD,?28,$E($P(^DIC(4,APCLVLOC,0),U),1,11),?40,APCLTYPE,?44,$E(APCLSC,1,15),?47,$E(APCLCLN,1,10),?52,^XTMP("APCL8A",APCLJOB,APCLBT,"VISITS",APCLVDFN)

 Q

 ;

HEAD 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 ;

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

 W APCL80

 W !,"AREA:  ",APCLAREC,"      ",APCLAREA,?47,"PCC-APC REPORT 1A",?68,"Page ",APCLPG

 W !,"S.U.:  ",APCLSUC,"      ",APCLSU,?47,"FISCAL YEAR ",APCLFYD

 W !,"FAC.:  ",APCLLOCC,"  ",APCLLOCP,?49,APCLDT

 W !?46,"VISITS NOT EXPORTED",!

 W APCL80,!

 I APCLPG=1 D FIRSTPG

 Q:$D(APCLQUIT)

 W APCL80,!

 W " HRN ",?8,"VISIT DATE/TIME",?28,"LOCATION",?39,"TYPE",?44,"SC",?45," CLIN",?55,"REASON",!,APCL80,!

 Q

 ;

APCL8AP   ; IHS/CMI/LAB - print apc report 1A ;

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

START     ;

 +1        SET APCL80="-----------------------------------------------------------------------------"

 +2        SET Y=$EXTRACT(APCLFYE,1,3)_"0000"

           DO DD^%DT

           SET APCLFYD=Y

           SET Y=DT

           DO DD^%DT

           SET APCLDT=Y

 +3        SET APCLLOCC=$PIECE(^AUTTLOC(APCLLOC,0),U,10)

           SET APCLLOCP=$PIECE(^DIC(4,APCLLOC,0),U)

 +4        SET APCLAREA=$PIECE(^AUTTLOC(APCLLOC,0),U,4)

           IF APCLAREA=""

               SET (APCLAREA,APCLAREC)="???"

               GOTO SU

 +5        IF '$DATA(^AUTTAREA(APCLAREA,0))

               SET (APCLAREA,APCLAREC)="???"

               GOTO SU

 +6        SET APCLAREC=$PIECE(^AUTTAREA(APCLAREA,0),U,2)

           SET APCLAREA=$PIECE(^AUTTAREA(APCLAREA,0),U)

SU        ;

 +1        SET APCLSU=$PIECE(^AUTTLOC(APCLLOC,0),U,5)

           IF APCLSU=""

               SET (APCLSU,APCLSUC)="???"

               GOTO START2

 +2        IF '$DATA(^AUTTSU(APCLSU,0))

               SET (APCLSU,APCLSUC)="999"

               GOTO START2

 +3        SET APCLSUC=$PIECE(^AUTTSU(APCLSU,0),U,3)

           SET APCLSU=$PIECE(^AUTTSU(APCLSU,0),U)

START2     SET (APCLPG,APCLVDFN,APCLPRIT)=0

           DO HEAD

 +1        KILL APCLQUIT

 +2        FOR 

               SET APCLVDFN=$ORDER(^XTMP("APCL8A",APCLJOB,APCLBT,"VISITS",APCLVDFN))

               IF APCLVDFN=""!($DATA(APCLQUIT))

                   QUIT 

               DO P

 +3       ;I $D(^XTMP("APCL8A",APCLJOB,APCLBT,"NO EXPORT")) D  I 1

 +4        WRITE !

DONE       DO DONE^APCLOSUT

 +1        KILL ^XTMP("APCL8A",APCLJOB,APCLBT)

 +2        QUIT 

FIRSTPG   ;

 +1        WRITE !,"Total Number of APC visits counted:  ",APCLGRAN

 +2        WRITE !,"Total Number of those APC Visits NOT Exported:  ",$SELECT($DATA(^XTMP("APCL8A",APCLJOB,APCLBT,"NO EXPORT")):^("NO EXPORT"),1:0)

 +3        WRITE !!,"Of the total number of visits counted in the 1A, but NOT exported to the",!,"National Data Warehouse, ",$SELECT($DATA(^XTMP("APCL8A",APCLJOB,APCLBT,"IN XREF")):^("IN XREF"),1:0)

 +4        WRITE " were not exported because they were posted ",!,"or modified after the last NDW export tape was generated.",!

 +5        IF '$DATA(^XTMP("APCL8A",APCLJOB,APCLBT,"VISITS"))

               SET APCLQUIT=1

               QUIT 

 +6        WRITE !,"The remaining ",($SELECT($DATA(^XTMP("APCL8A",APCLJOB,APCLBT,"NO EXPORT")):^("NO EXPORT"),1:0)-$SELECT($DATA(^XTMP("APCL8A",APCLJOB,APCLBT,"IN XREF")):^("IN XREF"),1:0))," visits are listed below.",!

 +7        QUIT 

P         ;

 +1       ;S DA=APCLVDFN,DIE="^AUPNVSIT(",DR=".13///^S X=DT" D ^DIE D ^XBFMK

 +2        IF $Y>(IOSL-5)

               DO HEAD

               IF $DATA(APCLQUIT)

                   QUIT 

 +3        SET APCLVREC=^AUPNVSIT(APCLVDFN,0)

           SET APCLVLOC=$PIECE(APCLVREC,U,6)

           SET APCLTYPE=$PIECE(APCLVREC,U,3)

           SET APCLSC=$PIECE(APCLVREC,U,7)

 +4        SET DFN=$PIECE(APCLVREC,U,5)

           SET APCLHRN=""

           IF $DATA(^AUPNPAT(DFN,41,APCLVLOC,0))

               SET APCLHRN=$PIECE(^AUPNPAT(DFN,41,APCLVLOC,0),U,2)

 +5        IF APCLHRN=""

               SET APCLHRN=$PIECE($GET(^AUPNPAT(DFN,41,DUZ(2),0)),U,2)

CLINIC    ;

 +1        SET APCLCLN=$PIECE(^AUPNVSIT(APCLVDFN,0),U,8)

           IF APCLCLN=""

               SET APCLCLN="--"

               GOTO VD

 +2        SET APCLCLN=$PIECE(^DIC(40.7,APCLCLN,0),U,2)

VD        ;

 +1        SET Y=+APCLVREC

           XECUTE ^DD("DD")

           SET APCLRD=Y

PRN       ;

 +1        WRITE !,APCLHRN,?8,APCLRD,?28,$EXTRACT($PIECE(^DIC(4,APCLVLOC,0),U),1,11),?40,APCLTYPE,?44,$EXTRACT(APCLSC,1,15),?47,$EXTRACT(APCLCLN,1,10),?52,^XTMP("APCL8A",APCLJOB,APCLBT,"VISITS",APCLVDFN)

 +2        QUIT 

 +3       ;

HEAD       IF 'APCLPG

               GOTO HEAD1

 +1        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     ;

 +1        IF $DATA(IOF)

               WRITE @IOF

           SET APCLPG=APCLPG+1

 +2        WRITE APCL80

 +3        WRITE !,"AREA:  ",APCLAREC,"      ",APCLAREA,?47,"PCC-APC REPORT 1A",?68,"Page ",APCLPG

 +4        WRITE !,"S.U.:  ",APCLSUC,"      ",APCLSU,?47,"FISCAL YEAR ",APCLFYD

 +5        WRITE !,"FAC.:  ",APCLLOCC,"  ",APCLLOCP,?49,APCLDT

 +6        WRITE !?46,"VISITS NOT EXPORTED",!

 +7        WRITE APCL80,!

 +8        IF APCLPG=1

               DO FIRSTPG

 +9        IF $DATA(APCLQUIT)

               QUIT 

 +10       WRITE APCL80,!

 +11       WRITE " HRN ",?8,"VISIT DATE/TIME",?28,"LOCATION",?39,"TYPE",?44,"SC",?45," CLIN",?55,"REASON",!,APCL80,!

 +12       QUIT 

 +13      ;