APCPSRP5.m

APCPSRP5 ; IHS/TUCSON/LAB - PRINT . SECTION AUGUST 14, 1992 ; [ 08/17/2003   8:15 PM ]

 ;;2.0;IHS PCC DATA EXTRACTION SYSTEM;**1,3**;APR 03, 1998

 ;IHS/CMI/LAB - modified for displaying #hospital visits

 ;IHS/CMI/LAB - XTMP

 ;

 I $Y>(IOSL-10) D HEAD^APCPSRP Q:$D(APCPSR("QUIT"))

 W !!!,"STATISTICAL DATABASE RECORDS EXPORTED"

 I '$P(^APCPLOG(APCPSR("LOG"),0),U,17) W !,"There were NO STATISTICAL DATABASE transactions generated.",!! G EOJ

 W !,"Following is a breakdown of all visits that generated STATISTICAL DATABASE",!,"transactions by Visit Date, Type, Location, Service Category, Clinic and",!," Primary Provider Discipline."

INPT ;

 S APCPSR("INPT CNT")=0

 S X=0 F  S X=$O(^APCPLOG(APCPSR("LOG"),21,X)) Q:X'=+X  I $D(^AUPNVSIT(X,0)) S V=^AUPNVSIT(X,0) I $P(^APCPLOG(APCPSR("LOG"),21,X,0),U,5),$P(V,U,7)="H",$P(V,U,6)=DUZ(2) S APCPSR("INPT CNT")=APCPSR("INPT CNT")+1

 I $Y>(IOSL-4) D HEAD^APCPSRP Q:$D(APCPSR("QUIT"))

 W !!,"Total Number of Hospitalization Visits to this Facility that were exported: ",APCPSR("INPT CNT"),!

VD ;

 ;

 S APCPSR("PTR")=0,APCPSR("T")="By Visit Date:",APCPSR("1")="V DATE STATDB",APCPSR("2")="V DATE STATDB",APCPSR("WC")=0

 D PROC Q:$D(APCPSR("QUIT"))

TYPE ;

 S APCPSR("PTR")=0,APCPSR("T")="By Type:",APCPSR("1")="TYPE STATDB",APCPSR("2")="TYPE STATDB CC",APCPSR("WC")=0

 D PROC Q:$D(APCPSR("QUIT"))

LOC ;

 S APCPSR("PTR")=1,APCPSR("T")="By Location:",APCPSR("1")="LOC STATDB",APCPSR("2")="LOC STATDB CC",APCPSR("WC")=0,APCPSR("GLOBAL")="^DIC(4,",APCPSR("PIECE")=1

 D PROC Q:$D(APCPSR("QUIT"))

SC ;

 S APCPSR("PTR")=0,APCPSR("T")="By Service Category:",APCPSR("1")="SC STATDB",APCPSR("2")="SC STATDB CC",APCPSR("WC")=0

 D PROC Q:$D(APCPSR("QUIT"))

CLINIC ;

 S APCPSR("PTR")=0,APCPSR("T")="By Clinic Type:",APCPSR("1")="CLINIC STATDB",APCPSR("2")="CLINIC STATDB CC",APCPSR("WC")=0

 D PROC Q:$D(APCPSR("QUIT"))

PROVDISC ;

 S APCPSR("PTR")=0,APCPSR("T")="By Provider Type (Primary Provider only):",APCPSR("1")="PROV STATDB",APCPSR("2")="PROV STATDB CC",APCPSR("WC")=0

 D PROC Q:$D(APCPSR("QUIT"))

EOJ ;

 Q

PROC ;

 I $Y>(IOSL-9) D HEAD^APCPSRP Q:$D(APCPSR("QUIT"))

 W !!?10,APCPSR("T")

 S APCPSR("N")=0 F  S APCPSR("N")=$O(^XTMP("APCPSR",APCPJOB,APCPBTH,"GEN",APCPSR("2"),APCPSR("N"))) Q:APCPSR("N")=""!($D(APCPSR("QUIT")))  D PROC1

 Q

PROC1 ;

 I APCPSR("2")["DATE" D PRNT Q

 S APCPSR("D")=0 F  S APCPSR("D")=$O(^XTMP("APCPSR",APCPJOB,APCPBTH,"GEN",APCPSR("2"),APCPSR("N"),APCPSR("D"))) Q:APCPSR("D")=""  D PRNT

 Q

PRNTDATE ;

 S Y=APCPSR("N") D DD^%DT W !?13,Y,?45,$J(^XTMP("APCPSR",APCPJOB,APCPBTH,"GEN",APCPSR("2"),APCPSR("N")),7) S APCPSR("WC")=APCPSR("WC")+1

 Q

PRNT ;

 I $Y>(IOSL-5) D HEAD^APCPSRP Q:$D(APCPSR("QUIT"))  W !!?10,APCPSR("T") W:APCPSR("WC")>0 " (cont.)"

 I APCPSR("1")="V DATE STATDB" D PRNTDATE Q

 S X=^XTMP("APCPSR",APCPJOB,APCPBTH,"GEN",APCPSR("2"),APCPSR("N"),APCPSR("D"))

 I APCPSR("PTR")=1 D PRNTPTR Q

 W !?13,APCPSR("D"),?45,$J(X,7) S APCPSR("WC")=APCPSR("WC")+1

 Q

PRNTPTR ;

 S G=APCPSR("GLOBAL")_APCPSR("D")_")"

 W !?13,$P(@G@(0),U,APCPSR("PIECE")),?45,$J(X,7) S APCPSR("WC")=APCPSR("WC")+1

 I APCPSR("1")="LOC" W ?55,"(IHS CODE: ",$P(^AUTTLOC(APCPSR("D"),0),U,10),")"

 K G

 Q

APCPSRP5  ; IHS/TUCSON/LAB - PRINT . SECTION AUGUST 14, 1992 ; [ 08/17/2003   8:15 PM ]

 +1       ;;2.0;IHS PCC DATA EXTRACTION SYSTEM;**1,3**;APR 03, 1998

 +2       ;IHS/CMI/LAB - modified for displaying #hospital visits

 +3       ;IHS/CMI/LAB - XTMP

 +4       ;

 +5        IF $Y>(IOSL-10)

               DO HEAD^APCPSRP

               IF $DATA(APCPSR("QUIT"))

                   QUIT 

 +6        WRITE !!!,"STATISTICAL DATABASE RECORDS EXPORTED"

 +7        IF '$PIECE(^APCPLOG(APCPSR("LOG"),0),U,17)

               WRITE !,"There were NO STATISTICAL DATABASE transactions generated.",!!

               GOTO EOJ

 +8        WRITE !,"Following is a breakdown of all visits that generated STATISTICAL DATABASE",!,"transactions by Visit Date, Type, Location, Service Category, Clinic and",!," Primary Provider Discipline."

INPT      ;

 +1        SET APCPSR("INPT CNT")=0

 +2        SET X=0

           FOR 

               SET X=$ORDER(^APCPLOG(APCPSR("LOG"),21,X))

               IF X'=+X

                   QUIT 

               IF $DATA(^AUPNVSIT(X,0))

                   SET V=^AUPNVSIT(X,0)

                   IF $PIECE(^APCPLOG(APCPSR("LOG"),21,X,0),U,5)

                       IF $PIECE(V,U,7)="H"

                           IF $PIECE(V,U,6)=DUZ(2)

                               SET APCPSR("INPT CNT")=APCPSR("INPT CNT")+1

 +3        IF $Y>(IOSL-4)

               DO HEAD^APCPSRP

               IF $DATA(APCPSR("QUIT"))

                   QUIT 

 +4        WRITE !!,"Total Number of Hospitalization Visits to this Facility that were exported: ",APCPSR("INPT CNT"),!

VD        ;

 +1       ;

 +2        SET APCPSR("PTR")=0

           SET APCPSR("T")="By Visit Date:"

           SET APCPSR("1")="V DATE STATDB"

           SET APCPSR("2")="V DATE STATDB"

           SET APCPSR("WC")=0

 +3        DO PROC

           IF $DATA(APCPSR("QUIT"))

               QUIT 

TYPE      ;

 +1        SET APCPSR("PTR")=0

           SET APCPSR("T")="By Type:"

           SET APCPSR("1")="TYPE STATDB"

           SET APCPSR("2")="TYPE STATDB CC"

           SET APCPSR("WC")=0

 +2        DO PROC

           IF $DATA(APCPSR("QUIT"))

               QUIT 

LOC       ;

 +1        SET APCPSR("PTR")=1

           SET APCPSR("T")="By Location:"

           SET APCPSR("1")="LOC STATDB"

           SET APCPSR("2")="LOC STATDB CC"

           SET APCPSR("WC")=0

           SET APCPSR("GLOBAL")="^DIC(4,"

           SET APCPSR("PIECE")=1

 +2        DO PROC

           IF $DATA(APCPSR("QUIT"))

               QUIT 

SC        ;

 +1        SET APCPSR("PTR")=0

           SET APCPSR("T")="By Service Category:"

           SET APCPSR("1")="SC STATDB"

           SET APCPSR("2")="SC STATDB CC"

           SET APCPSR("WC")=0

 +2        DO PROC

           IF $DATA(APCPSR("QUIT"))

               QUIT 

CLINIC    ;

 +1        SET APCPSR("PTR")=0

           SET APCPSR("T")="By Clinic Type:"

           SET APCPSR("1")="CLINIC STATDB"

           SET APCPSR("2")="CLINIC STATDB CC"

           SET APCPSR("WC")=0

 +2        DO PROC

           IF $DATA(APCPSR("QUIT"))

               QUIT 

PROVDISC  ;

 +1        SET APCPSR("PTR")=0

           SET APCPSR("T")="By Provider Type (Primary Provider only):"

           SET APCPSR("1")="PROV STATDB"

           SET APCPSR("2")="PROV STATDB CC"

           SET APCPSR("WC")=0

 +2        DO PROC

           IF $DATA(APCPSR("QUIT"))

               QUIT 

EOJ       ;

 +1        QUIT 

PROC      ;

 +1        IF $Y>(IOSL-9)

               DO HEAD^APCPSRP

               IF $DATA(APCPSR("QUIT"))

                   QUIT 

 +2        WRITE !!?10,APCPSR("T")

 +3        SET APCPSR("N")=0

           FOR 

               SET APCPSR("N")=$ORDER(^XTMP("APCPSR",APCPJOB,APCPBTH,"GEN",APCPSR("2"),APCPSR("N")))

               IF APCPSR("N")=""!($DATA(APCPSR("QUIT")))

                   QUIT 

               DO PROC1

 +4        QUIT 

PROC1     ;

 +1        IF APCPSR("2")["DATE"

               DO PRNT

               QUIT 

 +2        SET APCPSR("D")=0

           FOR 

               SET APCPSR("D")=$ORDER(^XTMP("APCPSR",APCPJOB,APCPBTH,"GEN",APCPSR("2"),APCPSR("N"),APCPSR("D")))

               IF APCPSR("D")=""

                   QUIT 

               DO PRNT

 +3        QUIT 

PRNTDATE  ;

 +1        SET Y=APCPSR("N")

           DO DD^%DT

           WRITE !?13,Y,?45,$JUSTIFY(^XTMP("APCPSR",APCPJOB,APCPBTH,"GEN",APCPSR("2"),APCPSR("N")),7)

           SET APCPSR("WC")=APCPSR("WC")+1

 +2        QUIT 

PRNT      ;

 +1        IF $Y>(IOSL-5)

               DO HEAD^APCPSRP

               IF $DATA(APCPSR("QUIT"))

                   QUIT 

               WRITE !!?10,APCPSR("T")

               IF APCPSR("WC")>0

                   WRITE " (cont.)"

 +2        IF APCPSR("1")="V DATE STATDB"

               DO PRNTDATE

               QUIT 

 +3        SET X=^XTMP("APCPSR",APCPJOB,APCPBTH,"GEN",APCPSR("2"),APCPSR("N"),APCPSR("D"))

 +4        IF APCPSR("PTR")=1

               DO PRNTPTR

               QUIT 

 +5        WRITE !?13,APCPSR("D"),?45,$JUSTIFY(X,7)

           SET APCPSR("WC")=APCPSR("WC")+1

 +6        QUIT 

PRNTPTR   ;

 +1        SET G=APCPSR("GLOBAL")_APCPSR("D")_")"

 +2        WRITE !?13,$PIECE(@G@(0),U,APCPSR("PIECE")),?45,$JUSTIFY(X,7)

           SET APCPSR("WC")=APCPSR("WC")+1

 +3        IF APCPSR("1")="LOC"

               WRITE ?55,"(IHS CODE: ",$PIECE(^AUTTLOC(APCPSR("D"),0),U,10),")"

 +4        KILL G

 +5        QUIT