APCLCPTD.m

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

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

 ;

DELIMIT ;EP - Set up header line, dash line

 S APCLFCNT=0

 K ^XTMP($J,"APCLFLAT") ;just in case

 K ^TMP($J,"APCLDELIMITED")

 S APCLDELC=0,APCLPIEC=0

PROC ;process printing of report

 I APCLDELT="F" D OPEN

 S APCLPG=0 K APCLQUIT

 I '$D(^XTMP("APCLCPT1",APCLJ,APCLH)) D HEADER W !!,"No data to report.",! G DONE

 S APCLPN="" F  S APCLPN=$O(^XTMP("APCLCPT1",APCLJ,APCLH,"CPTS",APCLPN)) Q:APCLPN=""!($D(APCLQUIT))  D

 .S APCLPIEN=0 F  S APCLPIEN=$O(^XTMP("APCLCPT1",APCLJ,APCLH,"CPTS",APCLPN,APCLPIEN)) Q:APCLPIEN'=+APCLPIEN!($D(APCLQUIT))  D

 ..D HEADER

 ..W !!,"Provider Name"_U_"Discipline"

 ..S APCLDISC=$O(^XTMP("APCLCPT1",APCLJ,APCLH,"CPTS",APCLPN,APCLPIEN,""))

 ..W !,APCLPN_U_APCLDISC

 ..I APCLOI="B"!(APCLOI="O") D

 ...D AMBHDR

 ...S APCLY="" F  S APCLY=$O(^XTMP("APCLCPT1",APCLJ,APCLH,"CPTS",APCLPN,APCLPIEN,APCLDISC,"OUTPATIENT",APCLY)) Q:APCLY=""!($D(APCLQUIT))  D

 ....S APCLN="" F  S APCLN=$O(^XTMP("APCLCPT1",APCLJ,APCLH,"CPTS",APCLPN,APCLPIEN,APCLDISC,"OUTPATIENT",APCLY,APCLN)) Q:APCLN=""!($D(APCLQUIT))  D PRNO

 ..;INPATIENT

 ..I APCLOI="B"!(APCLOI="I") D

 ...D INPHDR

 ...S APCLY="" F  S APCLY=$O(^XTMP("APCLCPT1",APCLJ,APCLH,"CPTS",APCLPN,APCLPIEN,APCLDISC,"INPATIENT",APCLY)) Q:APCLY=""!($D(APCLQUIT))  D

 ....S APCLN="" F  S APCLN=$O(^XTMP("APCLCPT1",APCLJ,APCLH,"CPTS",APCLPN,APCLPIEN,APCLDISC,"INPATIENT",APCLY,APCLN)) Q:APCLN=""!($D(APCLQUIT))  D PRNI

 ..;TOTALS

 ..I APCLOI="B"!(APCLOI="O") D

 ...S APCLCNT=$G(^XTMP("APCLCPT1",APCLJ,APCLH,"OUTPATIENT",APCLPN,APCLPIEN,APCLDISC))

 ...W !!,"Total Outpatient Visits: "_U_APCLCNT

 ..I APCLOI="B"!(APCLOI="I") D

 ...S APCLCNT=$G(^XTMP("APCLCPT1",APCLJ,APCLH,"INPATIENT",APCLPN,APCLPIEN,APCLDISC))

 ...W !!,"Total Inpatient Services: "_U_APCLCNT

 ..W !!,"Total Patients:  "_U_APCLCNT

 .Q

 Q

PRNO ;

 S APCLCNT=^XTMP("APCLCPT1",APCLJ,APCLH,"CPTS",APCLPN,APCLPIEN,APCLDISC,"OUTPATIENT",APCLY,APCLN)

 W !,APCLY_U_APCLN_U_APCLCNT

 Q

PRNI ;

 S APCLCNT=^XTMP("APCLCPT1",APCLJ,APCLH,"CPTS",APCLPN,APCLPIEN,APCLDISC,"INPATIENT",APCLY,APCLN)

 W !,APCLY_U_APCLN_U_APCLCNT

 Q

AMBHDR ;

 W !!,"Ambulatory/Outpatient Services:"

 W !!,"CPT Code"_U_"CPT Narrative"_U_"# Subtotaled by CPT"

 Q

INPHDR ;

 W !!,"Inpatient Services:"

 W !!,"CPT Code"_U_"CPT Narrative"_U_"# Subtotaled by CPT"

 Q

HEADER ;EP

 G:'APCLPG HEADER1

HEADER1 ;

 S APCLPG=APCLPG+1

 W !,$P(^VA(200,DUZ,0),U,2)_U_$$FMTE^XLFDT(DT)_U_"Page ",APCLPG,!

 W !,"***  CPT Code by Provider Report  ***",!

 S X="Visit Dates: "_$$FMTE^XLFDT(APCLBD)_" to "_$$FMTE^XLFDT(APCLED) W X,!

 Q

DONE ;

 ;write out delimited file

 I APCLDELT="F" D ^%ZISC

 K ^XTMP("APCLFLAT",$J),^TMP($J,"APCLDELIMITED")

 Q

OPEN ;write flat file from global

 ;if screen selected do screen

 ;USE GS FROM GPRA TO OPEN AND WRITE FILE

 ;I APCLDELT="S" D SCREEN Q

 S Y=$$OPEN^%ZISH(APCLHDIR,APCLDELF,"W")

 I Y=1 W:'$D(ZTQUEUED) !!,"Cannot open host file to write out DELIMITED data.  Notify programmer." Q

 U IO

 Q

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

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

 +2       ;

DELIMIT   ;EP - Set up header line, dash line

 +1        SET APCLFCNT=0

 +2       ;just in case

           KILL ^XTMP($JOB,"APCLFLAT")

 +3        KILL ^TMP($JOB,"APCLDELIMITED")

 +4        SET APCLDELC=0

           SET APCLPIEC=0

PROC      ;process printing of report

 +1        IF APCLDELT="F"

               DO OPEN

 +2        SET APCLPG=0

           KILL APCLQUIT

 +3        IF '$DATA(^XTMP("APCLCPT1",APCLJ,APCLH))

               DO HEADER

               WRITE !!,"No data to report.",!

               GOTO DONE

 +4        SET APCLPN=""

           FOR 

               SET APCLPN=$ORDER(^XTMP("APCLCPT1",APCLJ,APCLH,"CPTS",APCLPN))

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

                   QUIT 

               Begin DoDot:1

 +5                SET APCLPIEN=0

                   FOR 

                       SET APCLPIEN=$ORDER(^XTMP("APCLCPT1",APCLJ,APCLH,"CPTS",APCLPN,APCLPIEN))

                       IF APCLPIEN'=+APCLPIEN!($DATA(APCLQUIT))

                           QUIT 

                       Begin DoDot:2

 +6                        DO HEADER

 +7                        WRITE !!,"Provider Name"_U_"Discipline"

 +8                        SET APCLDISC=$ORDER(^XTMP("APCLCPT1",APCLJ,APCLH,"CPTS",APCLPN,APCLPIEN,""))

 +9                        WRITE !,APCLPN_U_APCLDISC

 +10                       IF APCLOI="B"!(APCLOI="O")

                               Begin DoDot:3

 +11                               DO AMBHDR

 +12                               SET APCLY=""

                                   FOR 

                                       SET APCLY=$ORDER(^XTMP("APCLCPT1",APCLJ,APCLH,"CPTS",APCLPN,APCLPIEN,APCLDISC,"OUTPATIENT",APCLY))

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

                                           QUIT 

                                       Begin DoDot:4

 +13                                       SET APCLN=""

                                           FOR 

                                               SET APCLN=$ORDER(^XTMP("APCLCPT1",APCLJ,APCLH,"CPTS",APCLPN,APCLPIEN,APCLDISC,"OUTPATIENT",APCLY,APCLN))

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

                                                   QUIT 

                                               DO PRNO

                                       End DoDot:4

                               End DoDot:3

 +14      ;INPATIENT

 +15                       IF APCLOI="B"!(APCLOI="I")

                               Begin DoDot:3

 +16                               DO INPHDR

 +17                               SET APCLY=""

                                   FOR 

                                       SET APCLY=$ORDER(^XTMP("APCLCPT1",APCLJ,APCLH,"CPTS",APCLPN,APCLPIEN,APCLDISC,"INPATIENT",APCLY))

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

                                           QUIT 

                                       Begin DoDot:4

 +18                                       SET APCLN=""

                                           FOR 

                                               SET APCLN=$ORDER(^XTMP("APCLCPT1",APCLJ,APCLH,"CPTS",APCLPN,APCLPIEN,APCLDISC,"INPATIENT",APCLY,APCLN))

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

                                                   QUIT 

                                               DO PRNI

                                       End DoDot:4

                               End DoDot:3

 +19      ;TOTALS

 +20                       IF APCLOI="B"!(APCLOI="O")

                               Begin DoDot:3

 +21                               SET APCLCNT=$GET(^XTMP("APCLCPT1",APCLJ,APCLH,"OUTPATIENT",APCLPN,APCLPIEN,APCLDISC))

 +22                               WRITE !!,"Total Outpatient Visits: "_U_APCLCNT

                               End DoDot:3

 +23                       IF APCLOI="B"!(APCLOI="I")

                               Begin DoDot:3

 +24                               SET APCLCNT=$GET(^XTMP("APCLCPT1",APCLJ,APCLH,"INPATIENT",APCLPN,APCLPIEN,APCLDISC))

 +25                               WRITE !!,"Total Inpatient Services: "_U_APCLCNT

                               End DoDot:3

 +26                       WRITE !!,"Total Patients:  "_U_APCLCNT

                       End DoDot:2

 +27               QUIT 

               End DoDot:1

 +28       QUIT 

PRNO      ;

 +1        SET APCLCNT=^XTMP("APCLCPT1",APCLJ,APCLH,"CPTS",APCLPN,APCLPIEN,APCLDISC,"OUTPATIENT",APCLY,APCLN)

 +2        WRITE !,APCLY_U_APCLN_U_APCLCNT

 +3        QUIT 

PRNI      ;

 +1        SET APCLCNT=^XTMP("APCLCPT1",APCLJ,APCLH,"CPTS",APCLPN,APCLPIEN,APCLDISC,"INPATIENT",APCLY,APCLN)

 +2        WRITE !,APCLY_U_APCLN_U_APCLCNT

 +3        QUIT 

AMBHDR    ;

 +1        WRITE !!,"Ambulatory/Outpatient Services:"

 +2        WRITE !!,"CPT Code"_U_"CPT Narrative"_U_"# Subtotaled by CPT"

 +3        QUIT 

INPHDR    ;

 +1        WRITE !!,"Inpatient Services:"

 +2        WRITE !!,"CPT Code"_U_"CPT Narrative"_U_"# Subtotaled by CPT"

 +3        QUIT 

HEADER    ;EP

 +1        IF 'APCLPG

               GOTO HEADER1

HEADER1   ;

 +1        SET APCLPG=APCLPG+1

 +2        WRITE !,$PIECE(^VA(200,DUZ,0),U,2)_U_$$FMTE^XLFDT(DT)_U_"Page ",APCLPG,!

 +3        WRITE !,"***  CPT Code by Provider Report  ***",!

 +4        SET X="Visit Dates: "_$$FMTE^XLFDT(APCLBD)_" to "_$$FMTE^XLFDT(APCLED)

           WRITE X,!

 +5        QUIT 

DONE      ;

 +1       ;write out delimited file

 +2        IF APCLDELT="F"

               DO ^%ZISC

 +3        KILL ^XTMP("APCLFLAT",$JOB),^TMP($JOB,"APCLDELIMITED")

 +4        QUIT 

OPEN      ;write flat file from global

 +1       ;if screen selected do screen

 +2       ;USE GS FROM GPRA TO OPEN AND WRITE FILE

 +3       ;I APCLDELT="S" D SCREEN Q

 +4        SET Y=$$OPEN^%ZISH(APCLHDIR,APCLDELF,"W")

 +5        IF Y=1

               IF '$DATA(ZTQUEUED)

                   WRITE !!,"Cannot open host file to write out DELIMITED data.  Notify programmer."

               QUIT 

 +6        USE IO

 +7        QUIT