Routine: APCLGCDC

APCLGCDC ; IHS/CMI/LAB - APCL Visits to General and Dental Clinic (Same Day) ;

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

 ;IHS/CMI/LAB - new report per task order

 ;this routine will print a list of visits that had a general clinic

 ;and dental clinic visit on the same day

MAIN ;-- this is the main routine driver

 W:$D(IOF) @IOF

 W !,"This report will produce a list of patients who have had a dental clinic",!,"visit and a general clinic visit on the same day.",!!

 D DTR G XIT:Y<0

 S XBRP="PRT^APCLGCDC",XBRC="SORT^APCLGCDC"

 S XBRX="XIT^APCLGCDC",XBNS="APCL"

DEMO ;

 D DEMOCHK^APCLUTL(.APCLDEMO)

 I APCLDEMO=-1 G MAIN

 D ^XBDBQUE

 D XIT

DTR ;-- get the date range

 S %DT="AE",%DT("A")="Enter the Beginning Date: "

 D ^%DT

 Q:Y<0

 S APCLBDT=+Y

 S APCLSBDT=APCLBDT-.00001

 K %DT

 S %DT="AE",%DT("A")="Enter the End Date: "

 D ^%DT

 Q:Y<0

 S APCLEDT=+Y

 S APCLSEDT=APCLEDT+.99999

 K %DT

 K DIR

 S APCLLOC=$$GETLOC^APCLOCCK

 I APCLLOC=-1 S Y=-1

SORT ;-- get loop through the visit file

 S APCLH=$H,APCLJ=$J

 S APCLDESC="Visits to General Clinic and Dental Clinic on same day"

 S ^XTMP("APCLGCDC",APCLJ,APCLH,0)=$$DT14_U_DT_U_APCLDESC

 S APCLGEN=$O(^DIC(40.7,"B","GENERAL",0))

 S APCLDEN=$O(^DIC(40.7,"B","DENTAL",0))

 S APCLDA=APCLSBDT F  S APCLDA=$O(^AUPNVSIT("B",APCLDA)) Q:APCLDA>APCLSEDT!(APCLDA="")  D

 . S APCLDFN=0 F  S APCLDFN=$O(^AUPNVSIT("B",APCLDA,APCLDFN)) Q:APCLDFN=""  D

 .. Q:'$D(^AUPNVSIT(APCLDFN,0))

 .. Q:$P(^AUPNVSIT(APCLDFN,0),U,5)=""

 .. Q:$$DEMO^APCLUTL($P(^AUPNVSIT(APCLDFN,0),U,5),$G(APCLDEMO))

 .. Q:$P(^AUPNVSIT(APCLDFN,0),U,8)=""

 .. I $$CHKLOC^APCLOCCK(APCLLOC,$P(^AUPNVSIT(APCLDFN,0),U,6))=0 Q

 .. S APCLVDT=$P(APCLDA,".")

 .. S APCLPAT=$P(^(0),U,5)

 .. S APCLCLN=$P(^(0),U,8)

 .. I APCLCLN=APCLGEN S $P(^TMP("APCLGCDC",$J,APCLPAT,APCLVDT),U)=1

 .. I APCLCLN=APCLDEN S $P(^TMP("APCLGCDC",$J,APCLPAT,APCLVDT),U,2)=1

 S APCLTP=0 F  S APCLTP=$O(^TMP("APCLGCDC",$J,APCLTP)) Q:APCLTP=""  D

 . S APCLTV=0 F  S APCLTV=$O(^TMP("APCLGCDC",$J,APCLTP,APCLTV)) Q:APCLTV=""  D

 .. I $P(^TMP("APCLGCDC",$J,APCLTP,APCLTV),U),$P(^TMP("APCLGCDC",$J,APCLTP,APCLTV),U,2) S ^XTMP("APCLGCDC",APCLJ,APCLH,APCLTV,APCLTP)=""

PRT ;-- print out the routine

 D XHDR

 I '$D(^XTMP("APCLGCDC",APCLJ,APCLH)) W !!,"No visits to report." G EOJ

 S APCLXV=0 F  S APCLXV=$O(^XTMP("APCLGCDC",APCLJ,APCLH,APCLXV)) Q:APCLXV=""!$D(DIRUT)  D

 . S APCLXP=0 F  S APCLXP=$O(^XTMP("APCLGCDC",APCLJ,APCLH,APCLXV,APCLXP)) Q:APCLXP=""!$D(DIRUT)  D

 .. D:$Y+2>IOSL HDR Q:$D(DIRUT)

 .. W !,$$FMTE^XLFDT(APCLXV),?20,$$VAL^XBDIQ1(2,APCLXP,.01)

 .. W ?55,$$HRN^AUPNPAT(APCLXP,DUZ(2))

EOJ ;

 K ^XTMP("APCLGCDC",APCLJ,APCLH)

 K APCLH,APCLJ

HDR ;-- report header

 I $E(IOST,1,1)="C" S DIR(0)="E" D ^DIR I Y<1 S DIRUT=1 Q

XHDR W @IOF

 W !,?16,"General Clinic and Dental Clinic Visits (Same Day)"

 S APCLLOCT=$S(APCLLOC=0:"ALL",1:"SELECTED")

 S APCLLENG=21+$L(APCLLOCT)

 W !,?((80-APCLLENG)/2),"Location of Visits:  ",APCLLOCT

 W !!,"Date Range: "_$$FMTE^XLFDT(APCLBDT)_" to "_$$FMTE^XLFDT(APCLEDT)

W !

 W !,"Visit Date",?20,"Patient Name",?55,"Chart #",!

 F XI=1:1:80 W "-"

XIT ;-- kill variables and quit

 K APCLBDT,APCLCLN,APCLDA,APCLDEN,APCLDESC,APCLDFN,APCLEDT,APCLGEN

 K APCLPAT,APCLSEDT,APCDTP,APCLTV,APCLVDT,APCLXP,APCLXV,APCLSBDT

 K X,X1,X2,XBNS,XBRC,XBRP,XBRX,XI,Y,APCLTP

 K ^TMP("APCLGCDC",$J)

DT14() ;-- return 14 days in the future

 S X1=DT,X2=+14 D C^%DTC

Q X

APCLGCDC  ; IHS/CMI/LAB - APCL Visits to General and Dental Clinic (Same Day) ;

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

 +2       ;IHS/CMI/LAB - new report per task order

 +3       ;

 +4       ;this routine will print a list of visits that had a general clinic

 +5       ;and dental clinic visit on the same day

 +6       ;

MAIN      ;-- this is the main routine driver

 +1        IF $DATA(IOF)

               WRITE @IOF

 +2        WRITE !,"This report will produce a list of patients who have had a dental clinic",!,"visit and a general clinic visit on the same day.",!!

 +3        DO DTR

           IF Y<0

               GOTO XIT

 +4        SET XBRP="PRT^APCLGCDC"

           SET XBRC="SORT^APCLGCDC"

 +5        SET XBRX="XIT^APCLGCDC"

           SET XBNS="APCL"

DEMO      ;

 +1        DO DEMOCHK^APCLUTL(.APCLDEMO)

 +2        IF APCLDEMO=-1

               GOTO MAIN

 +3        DO ^XBDBQUE

 +4        DO XIT

 +5        QUIT

 +6       ;

DTR       ;-- get the date range

 +1        SET %DT="AE"

           SET %DT("A")="Enter the Beginning Date: "

 +2        DO ^%DT

 +3        IF Y<0

               QUIT

 +4        SET APCLBDT=+Y

 +5        SET APCLSBDT=APCLBDT-.00001

 +6        KILL %DT

 +7        SET %DT="AE"

           SET %DT("A")="Enter the End Date: "

 +8        DO ^%DT

 +9        IF Y<0

               QUIT

 +10       SET APCLEDT=+Y

 +11       SET APCLSEDT=APCLEDT+.99999

 +12       KILL %DT

 +13       KILL DIR

 +14      ;

 +15       SET APCLLOC=$$GETLOC^APCLOCCK

 +16       IF APCLLOC=-1

               SET Y=-1

 +17       QUIT

 +18      ;

SORT      ;-- get loop through the visit file

 +1        SET APCLH=$HOROLOG

           SET APCLJ=$JOB

 +2        SET APCLDESC="Visits to General Clinic and Dental Clinic on same day"

 +3        SET ^XTMP("APCLGCDC",APCLJ,APCLH,0)=$$DT14_U_DT_U_APCLDESC

 +4        SET APCLGEN=$ORDER(^DIC(40.7,"B","GENERAL",0))

 +5        SET APCLDEN=$ORDER(^DIC(40.7,"B","DENTAL",0))

 +6        SET APCLDA=APCLSBDT

FOR

               SET APCLDA=$ORDER(^AUPNVSIT("B",APCLDA))

               IF APCLDA>APCLSEDT!(APCLDA="")

                   QUIT

               Begin DoDot:1

 +7                SET APCLDFN=0

FOR

                       SET APCLDFN=$ORDER(^AUPNVSIT("B",APCLDA,APCLDFN))

                       IF APCLDFN=""

                           QUIT

                       Begin DoDot:2

 +8                        IF '$DATA(^AUPNVSIT(APCLDFN,0))

                               QUIT

 +9                        IF $PIECE(^AUPNVSIT(APCLDFN,0),U,5)=""

                               QUIT

 +10                       IF $$DEMO^APCLUTL($PIECE(^AUPNVSIT(APCLDFN,0),U,5),$GET(APCLDEMO))

                               QUIT

 +11                       IF $PIECE(^AUPNVSIT(APCLDFN,0),U,8)=""

                               QUIT

 +12                       IF $$CHKLOC^APCLOCCK(APCLLOC,$PIECE(^AUPNVSIT(APCLDFN,0),U,6))=0

                               QUIT

 +13                       SET APCLVDT=$PIECE(APCLDA,".")

 +14                       SET APCLPAT=$PIECE(^(0),U,5)

 +15                       SET APCLCLN=$PIECE(^(0),U,8)

 +16                       IF APCLCLN=APCLGEN

                               SET $PIECE(^TMP("APCLGCDC",$JOB,APCLPAT,APCLVDT),U)=1

 +17                       IF APCLCLN=APCLDEN

                               SET $PIECE(^TMP("APCLGCDC",$JOB,APCLPAT,APCLVDT),U,2)=1

                       End DoDot:2

               End DoDot:1

 +18       SET APCLTP=0

FOR

               SET APCLTP=$ORDER(^TMP("APCLGCDC",$JOB,APCLTP))

               IF APCLTP=""

                   QUIT

               Begin DoDot:1

 +19               SET APCLTV=0

FOR

                       SET APCLTV=$ORDER(^TMP("APCLGCDC",$JOB,APCLTP,APCLTV))

                       IF APCLTV=""

                           QUIT

                       Begin DoDot:2

 +20                       IF $PIECE(^TMP("APCLGCDC",$JOB,APCLTP,APCLTV),U)

                               IF $PIECE(^TMP("APCLGCDC",$JOB,APCLTP,APCLTV),U,2)

                                   SET ^XTMP("APCLGCDC",APCLJ,APCLH,APCLTV,APCLTP)=""

                       End DoDot:2

               End DoDot:1

 +21       QUIT

 +22      ;

PRT       ;-- print out the routine

 +1        DO XHDR

 +2        IF '$DATA(^XTMP("APCLGCDC",APCLJ,APCLH))

               WRITE !!,"No visits to report."

               GOTO EOJ

 +3        SET APCLXV=0

FOR

               SET APCLXV=$ORDER(^XTMP("APCLGCDC",APCLJ,APCLH,APCLXV))

               IF APCLXV=""!$DATA(DIRUT)

                   QUIT

               Begin DoDot:1

 +4                SET APCLXP=0

FOR

                       SET APCLXP=$ORDER(^XTMP("APCLGCDC",APCLJ,APCLH,APCLXV,APCLXP))

                       IF APCLXP=""!$DATA(DIRUT)

                           QUIT

                       Begin DoDot:2

 +5                        IF $Y+2>IOSL

                               DO HDR

                           IF $DATA(DIRUT)

                               QUIT

 +6                        WRITE !,$$FMTE^XLFDT(APCLXV),?20,$$VAL^XBDIQ1(2,APCLXP,.01)

 +7                        WRITE ?55,$$HRN^AUPNPAT(APCLXP,DUZ(2))

                       End DoDot:2

               End DoDot:1

 +8       ;

EOJ       ;

 +1        KILL ^XTMP("APCLGCDC",APCLJ,APCLH)

 +2        KILL APCLH,APCLJ

 +3        QUIT

 +4       ;

HDR       ;-- report header

 +1        IF $EXTRACT(IOST,1,1)="C"

               SET DIR(0)="E"

               DO ^DIR

               IF Y<1

                   SET DIRUT=1

                   QUIT

XHDR       WRITE @IOF

 +1        WRITE !,?16,"General Clinic and Dental Clinic Visits (Same Day)"

 +2        SET APCLLOCT=$SELECT(APCLLOC=0:"ALL",1:"SELECTED")

 +3        SET APCLLENG=21+$LENGTH(APCLLOCT)

 +4        WRITE !,?((80-APCLLENG)/2),"Location of Visits:  ",APCLLOCT

 +5        WRITE !!,"Date Range: "_$$FMTE^XLFDT(APCLBDT)_" to "_$$FMTE^XLFDT(APCLEDT)

 +6        WRITE !

 +7        WRITE !,"Visit Date",?20,"Patient Name",?55,"Chart #",!

 +8        FOR XI=1:1:80

               WRITE "-"

 +9        QUIT

 +10      ;

XIT       ;-- kill variables and quit

 +1        KILL APCLBDT,APCLCLN,APCLDA,APCLDEN,APCLDESC,APCLDFN,APCLEDT,APCLGEN

 +2        KILL APCLPAT,APCLSEDT,APCDTP,APCLTV,APCLVDT,APCLXP,APCLXV,APCLSBDT

 +3        KILL X,X1,X2,XBNS,XBRC,XBRP,XBRX,XI,Y,APCLTP

 +4        KILL ^TMP("APCLGCDC",$JOB)

 +5        QUIT

 +6       ;

DT14()    ;-- return 14 days in the future

 +1        SET X1=DT

           SET X2=+14

           DO C^%DTC

 +2        QUIT X

 +3       ;

APCLGCDC.m