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
Q
;
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
Q
;
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)=""
Q
;
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
Q
;
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 "-"
Q
;
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)
Q
;
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 ;
