APCDDVL1 ; IHS/CMI/LAB - report on checked in visits with no pov ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;
;
START ;
D EOJ
D INFORM
GETDATES ;
BD ;get beginning date
W ! S DIR(0)="D^:DT:EP",DIR("A")="Enter beginning Visit Date" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) G EOJ
S APCDBD=Y
ED ;get ending date
W ! S DIR(0)="DA^"_APCDBD_":DT:EP",DIR("A")="Enter ending Visit Date: " S Y=APCDBD D DD^%DT S Y="" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) G BD
S APCDED=Y
;
WHICH ;
K APCDHLOC
K DIR
S DIR(0)="S^A:ALL Visits;H:Visits to Selected Hospital Locations (Scheduling Clinics)"
S DIR("A")="Which Visits do you want to display",DIR("B")="A" KILL DA D ^DIR KILL DIR
I $D(DIRUT) G BD
I Y="A" K APCDHLOC G SORT
HLOC ;
S DIC="^SC(",DIC(0)="AEMQ",DIC("A")="Which HOSPITAL LOCATION: " D ^DIC K DIC
I X="" W:'$D(APCDHLOC) !!,"No Hospital Locations selected, all will be included." G SORT
I Y=-1 W:'$D(APCDHLOC) !!,"No Hospital Locations selected, all will be included." G SORT
S APCDHLOC(+Y)=""
G HLOC
SORT ;
S APCDCSRT=""
W !!,"*** NOTE: If you pick Visit date order the report will be sorted by Visit date",!,"and sub-sorted by clinic code. All others will be sub-sorted by visit date."
S DIR(0)="S^T:Terminal Digit Order;H:Health Record Number Order;D:Visit Date Order;C:Clinic Code Order",DIR("A")="Sort the report by",DIR("B")="T" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) G BD
S APCDCSRT=Y
DEMO ;
D DEMOCHK^APCLUTL(.APCDDEMO)
I APCDDEMO=-1 G BD
ZIS ;call to XBDBQUE
S XBRP="PRINT^APCDDVL1",XBRC="PROCESS^APCDDVL1",XBRX="EOJ^APCDDVL1",XBNS="APCD"
D ^XBDBQUE
D EOJ
Q
;
EOJ ;
D EN^XBVK("APCD")
Q
PROCESS ;EP - called from XBDBQUE
S ^XTMP("APCDDVL1",0)=$$FMADD^XLFDT(DT,14)_"^"_DT_"^"_"APCD - CHECKED IN VISIT REPORT"
S APCDJ=$J,APCDBT=$H,APCDTOT=0
;go through all visits (B index) check for option used to create
;and check for no POV
;print name, hrn, date/time, clinic, primary prov, and any other visits on that day
;
S APCDT=APCDBD-.0001,APCDEND=APCDED+.2400
F S APCDT=$O(^AUPNVSIT("B",APCDT)) Q:'APCDT!(APCDT>APCDEND) D
. S APCDV=0
. F S APCDV=$O(^AUPNVSIT("B",APCDT,APCDV)) Q:'APCDV D
.. I $$VAL^XBDIQ1(9000010,APCDV,.24)'="SD IHS PCC LINK" Q ;not created by check in
.. Q:$$DEMO^APCLUTL($P(^AUPNVSIT(APCDV,0),U,5),APCDDEMO)
.. I $P(^AUPNVSIT(APCDV,0),U,6)'=DUZ(2) Q ;another facilities visit
.. Q:$D(^AUPNVPOV("AD",APCDV)) ;already been coded
.. Q:$P(^AUPNVSIT(APCDV,0),U,11) ;deleted
.. I $D(APCDHLOC) S X=$P(^AUPNVSIT(APCDV,0),U,22) Q:X="" Q:'$D(APCDHLOC(X))
.. S APCDSORT="" D GETSORT I APCDSORT="" S APCDSORT="??"
.. S ^XTMP("APCDDVL1",APCDJ,APCDBT,"VISITS",APCDSORT,APCDSSRT,APCDV)="",APCDTOT=APCDTOT+1
.. Q
. Q
Q
GETSORT ;get sort value
I APCDCSRT="D" S APCDSORT=$P($P(^AUPNVSIT(APCDV,0),U),"."),APCDSSRT=$$CLINIC^APCLV(APCDV,"C") S:APCDSSRT="" APCDSSRT="??" Q
I APCDCSRT="C" S APCDSORT=$$CLINIC^APCLV(APCDV,"C"),APCDSSRT=$P($P(^AUPNVSIT(APCDV,0),U),".") Q ;clinic code
;hrn sort values
S APCDSORT=$$HRN^AUPNPAT($P(^AUPNVSIT(APCDV,0),U,5),DUZ(2)),APCDSSRT=$P($P(^AUPNVSIT(APCDV,0),U),".") S:APCDSORT="" APCDSORT="?????"
Q:APCDSORT="?????"
Q:APCDCSRT'="T"
S APCDSORT=APCDSORT+10000000,APCDSORT=$E(APCDSORT,7,8)_"-"_+$E(APCDSORT,2,8)
Q
PRINT ;EP - called from XBDBQUE
S APCDQUIT="",APCDPG=0 D HDR
I '$D(^XTMP("APCDDVL1",APCDJ,APCDBT)) W !!,"NO DATA TO REPORT",! G DONE
S APCDSORT="" F S APCDSORT=$O(^XTMP("APCDDVL1",APCDJ,APCDBT,"VISITS",APCDSORT)) Q:APCDSORT=""!(APCDQUIT) D
.S APCDSSRT="" F S APCDSSRT=$O(^XTMP("APCDDVL1",APCDJ,APCDBT,"VISITS",APCDSORT,APCDSSRT)) Q:APCDSSRT=""!(APCDQUIT) D
.. S APCDV=0 F S APCDV=$O(^XTMP("APCDDVL1",APCDJ,APCDBT,"VISITS",APCDSORT,APCDSSRT,APCDV)) Q:APCDV'=+APCDV!(APCDQUIT) D
... I $Y>(IOSL-4) D HDR Q:APCDQUIT
... S APCDVR=^AUPNVSIT(APCDV,0)
... W !,$E($P(^DPT($P(APCDVR,U,5),0),U),1,15),?16,$$HRN^AUPNPAT($P(APCDVR,U,5),DUZ(2)),?23,$$FMTE^XLFDT($P(APCDVR,U)),?42,$P(APCDVR,U,7),?45,$$CLINIC^APCLV(APCDV,"C")
... W ?48,$E($$VAL^XBDIQ1(9000010,APCDV,.22),1,15),?64,$$PRIMPROV^APCLV(APCDV,"P")
... S C=$$VCNT(APCDV) W ?72,$P(C,U)," ",$P(C,U,2)
... Q
.. Q
. Q
G:APCDQUIT DONE
I $Y>(IOSL-3) D HDR G:APCDQUIT DONE
W !!,"Total Number of Visits: ",APCDTOT
DONE ;
K ^XTMP("APCDDVL1",APCDJ,APCDBT),APCDJ,APCDBT
I $E(IOST)="C",IO=IO(0) S DIR(0)="EO",DIR("A")="End of report. HIT RETURN" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
W:$D(IOF) @IOF
Q
VCNT(V) ;return number of other visits on this date
I '$G(V) Q 0
I '$D(^AUPNVSIT(V)) Q 0
NEW D,X,Y,C,DATE,END,P
S P=$P(^AUPNVSIT(V,0),U,5)
S D=$P($P(^AUPNVSIT(V,0),U),".")
S (C,C1)=0,DATE=(9999999-D)-.0001,END=(9999999-D)+.9999999
F S DATE=$O(^AUPNVSIT("AA",P,DATE)) Q:'DATE!(DATE>END) D
. S X=0 F S X=$O(^AUPNVSIT("AA",P,DATE,X)) Q:X'=+X I X'=V,'$P(^AUPNVSIT(X,0),U,11) S C=C+1 I $D(^AUPNVPOV("AD",X)),$D(^AUPNVPRV("AD",X)) S C1=C1+1
Q C_U_C1
;
HDR ;header for report
I 'APCDPG G HDR1
I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S APCDQUIT=1 Q
HDR1 ;
W:$D(IOF) @IOF S APCDPG=APCDPG+1
W $P(^VA(200,DUZ,0),U,2),$$CTR($$FMTE^XLFDT(DT)),?71,"Page ",APCDPG,!
W $$CTR($$LOC),!
W $$CTR("CHECKED IN VISITS WITH NO POV (NOT YET CODED)"),!
NEW % S %="Visit dates: "_$$FMTE^XLFDT(APCDBD)_" to "_$$FMTE^XLFDT(APCDED) W $$CTR(%),! ;CMI/TUCSON added 11/3/98
W "** Last column is the number of other visits on the same day and the",!," # of those visits that are complete",!!
W ?3,"PATIENT NAME",?17," HRN",?23,"VISIT DATE&TIME",?42,"SC",?45,"CL",?48,"HOSPITAL LOC",?64,"PROV",?72,"# visits",!
W $TR($J(" ",80)," ","-"),!
Q
CTR(X,Y) ;EP - Center X in a field Y wide.
Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
;----------
USR() ;EP - Return name of current user from ^VA(200.
Q $S($G(DUZ):$S($D(^VA(200,DUZ,0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
;----------
LOC() ;EP - Return location name from file 4 based on DUZ(2).
Q $S($G(DUZ(2)):$S($D(^DIC(4,DUZ(2),0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
;----------
INFORM ;let user know what is gong on
W:$D(IOF) @IOF
W !!,$$CTR($$LOC,80)
W !,$$CTR($$USR,80),!!
F I=1:1 S X=$P($T(INTRO+I),";;",2) Q:X="END" W !,X
K I,X
Q
INTRO ;;
;;This report will list all PCC Visits that were created by the
;;Scheduling Check-In process that do not yet have a Purpose of Visit.
;;This report will be used to determine if PCC forms have been submitted
;;for these visits or if an additional visit has been created for this scheduled
;;visit.
;;END
APCDDVL1 ; IHS/CMI/LAB - report on checked in visits with no pov ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;
+3 ;
START ;
+1 DO EOJ
+2 DO INFORM
GETDATES ;
BD ;get beginning date
+1 WRITE !
SET DIR(0)="D^:DT:EP"
SET DIR("A")="Enter beginning Visit Date"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
GOTO EOJ
+3 SET APCDBD=Y
ED ;get ending date
+1 WRITE !
SET DIR(0)="DA^"_APCDBD_":DT:EP"
SET DIR("A")="Enter ending Visit Date: "
SET Y=APCDBD
DO DD^%DT
SET Y=""
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
GOTO BD
+3 SET APCDED=Y
+4 ;
WHICH ;
+1 KILL APCDHLOC
+2 KILL DIR
+3 SET DIR(0)="S^A:ALL Visits;H:Visits to Selected Hospital Locations (Scheduling Clinics)"
+4 SET DIR("A")="Which Visits do you want to display"
SET DIR("B")="A"
KILL DA
DO ^DIR
KILL DIR
+5 IF $DATA(DIRUT)
GOTO BD
+6 IF Y="A"
KILL APCDHLOC
GOTO SORT
HLOC ;
+1 SET DIC="^SC("
SET DIC(0)="AEMQ"
SET DIC("A")="Which HOSPITAL LOCATION: "
DO ^DIC
KILL DIC
+2 IF X=""
IF '$DATA(APCDHLOC)
WRITE !!,"No Hospital Locations selected, all will be included."
GOTO SORT
+3 IF Y=-1
IF '$DATA(APCDHLOC)
WRITE !!,"No Hospital Locations selected, all will be included."
GOTO SORT
+4 SET APCDHLOC(+Y)=""
+5 GOTO HLOC
SORT ;
+1 SET APCDCSRT=""
+2 WRITE !!,"*** NOTE: If you pick Visit date order the report will be sorted by Visit date",!,"and sub-sorted by clinic code. All others will be sub-sorted by visit date."
+3 SET DIR(0)="S^T:Terminal Digit Order;H:Health Record Number Order;D:Visit Date Order;C:Clinic Code Order"
SET DIR("A")="Sort the report by"
SET DIR("B")="T"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+4 IF $DATA(DIRUT)
GOTO BD
+5 SET APCDCSRT=Y
DEMO ;
+1 DO DEMOCHK^APCLUTL(.APCDDEMO)
+2 IF APCDDEMO=-1
GOTO BD
ZIS ;call to XBDBQUE
+1 SET XBRP="PRINT^APCDDVL1"
SET XBRC="PROCESS^APCDDVL1"
SET XBRX="EOJ^APCDDVL1"
SET XBNS="APCD"
+2 DO ^XBDBQUE
+3 DO EOJ
+4 QUIT
+5 ;
EOJ ;
+1 DO EN^XBVK("APCD")
+2 QUIT
PROCESS ;EP - called from XBDBQUE
+1 SET ^XTMP("APCDDVL1",0)=$$FMADD^XLFDT(DT,14)_"^"_DT_"^"_"APCD - CHECKED IN VISIT REPORT"
+2 SET APCDJ=$JOB
SET APCDBT=$HOROLOG
SET APCDTOT=0
+3 ;go through all visits (B index) check for option used to create
+4 ;and check for no POV
+5 ;print name, hrn, date/time, clinic, primary prov, and any other visits on that day
+6 ;
+7 SET APCDT=APCDBD-.0001
SET APCDEND=APCDED+.2400
+8 FOR
SET APCDT=$ORDER(^AUPNVSIT("B",APCDT))
IF 'APCDT!(APCDT>APCDEND)
QUIT
Begin DoDot:1
+9 SET APCDV=0
+10 FOR
SET APCDV=$ORDER(^AUPNVSIT("B",APCDT,APCDV))
IF 'APCDV
QUIT
Begin DoDot:2
+11 ;not created by check in
IF $$VAL^XBDIQ1(9000010,APCDV,.24)'="SD IHS PCC LINK"
QUIT
+12 IF $$DEMO^APCLUTL($PIECE(^AUPNVSIT(APCDV,0),U,5),APCDDEMO)
QUIT
+13 ;another facilities visit
IF $PIECE(^AUPNVSIT(APCDV,0),U,6)'=DUZ(2)
QUIT
+14 ;already been coded
IF $DATA(^AUPNVPOV("AD",APCDV))
QUIT
+15 ;deleted
IF $PIECE(^AUPNVSIT(APCDV,0),U,11)
QUIT
+16 IF $DATA(APCDHLOC)
SET X=$PIECE(^AUPNVSIT(APCDV,0),U,22)
IF X=""
QUIT
IF '$DATA(APCDHLOC(X))
QUIT
+17 SET APCDSORT=""
DO GETSORT
IF APCDSORT=""
SET APCDSORT="??"
+18 SET ^XTMP("APCDDVL1",APCDJ,APCDBT,"VISITS",APCDSORT,APCDSSRT,APCDV)=""
SET APCDTOT=APCDTOT+1
+19 QUIT
End DoDot:2
+20 QUIT
End DoDot:1
+21 QUIT
GETSORT ;get sort value
+1 IF APCDCSRT="D"
SET APCDSORT=$PIECE($PIECE(^AUPNVSIT(APCDV,0),U),".")
SET APCDSSRT=$$CLINIC^APCLV(APCDV,"C")
IF APCDSSRT=""
SET APCDSSRT="??"
QUIT
+2 ;clinic code
IF APCDCSRT="C"
SET APCDSORT=$$CLINIC^APCLV(APCDV,"C")
SET APCDSSRT=$PIECE($PIECE(^AUPNVSIT(APCDV,0),U),".")
QUIT
+3 ;hrn sort values
+4 SET APCDSORT=$$HRN^AUPNPAT($PIECE(^AUPNVSIT(APCDV,0),U,5),DUZ(2))
SET APCDSSRT=$PIECE($PIECE(^AUPNVSIT(APCDV,0),U),".")
IF APCDSORT=""
SET APCDSORT="?????"
+5 IF APCDSORT="?????"
QUIT
+6 IF APCDCSRT'="T"
QUIT
+7 SET APCDSORT=APCDSORT+10000000
SET APCDSORT=$EXTRACT(APCDSORT,7,8)_"-"_+$EXTRACT(APCDSORT,2,8)
+8 QUIT
PRINT ;EP - called from XBDBQUE
+1 SET APCDQUIT=""
SET APCDPG=0
DO HDR
+2 IF '$DATA(^XTMP("APCDDVL1",APCDJ,APCDBT))
WRITE !!,"NO DATA TO REPORT",!
GOTO DONE
+3 SET APCDSORT=""
FOR
SET APCDSORT=$ORDER(^XTMP("APCDDVL1",APCDJ,APCDBT,"VISITS",APCDSORT))
IF APCDSORT=""!(APCDQUIT)
QUIT
Begin DoDot:1
+4 SET APCDSSRT=""
FOR
SET APCDSSRT=$ORDER(^XTMP("APCDDVL1",APCDJ,APCDBT,"VISITS",APCDSORT,APCDSSRT))
IF APCDSSRT=""!(APCDQUIT)
QUIT
Begin DoDot:2
+5 SET APCDV=0
FOR
SET APCDV=$ORDER(^XTMP("APCDDVL1",APCDJ,APCDBT,"VISITS",APCDSORT,APCDSSRT,APCDV))
IF APCDV'=+APCDV!(APCDQUIT)
QUIT
Begin DoDot:3
+6 IF $Y>(IOSL-4)
DO HDR
IF APCDQUIT
QUIT
+7 SET APCDVR=^AUPNVSIT(APCDV,0)
+8 WRITE !,$EXTRACT($PIECE(^DPT($PIECE(APCDVR,U,5),0),U),1,15),?16,$$HRN^AUPNPAT($PIECE(APCDVR,U,5),DUZ(2)),?23,$$FMTE^XLFDT($PIECE(APCDVR,U)),?42,$PIECE(APCDVR,U,7),?45,$$CLINIC^APCLV(APCDV,"C")
+9 WRITE ?48,$EXTRACT($$VAL^XBDIQ1(9000010,APCDV,.22),1,15),?64,$$PRIMPROV^APCLV(APCDV,"P")
+10 SET C=$$VCNT(APCDV)
WRITE ?72,$PIECE(C,U)," ",$PIECE(C,U,2)
+11 QUIT
End DoDot:3
+12 QUIT
End DoDot:2
+13 QUIT
End DoDot:1
+14 IF APCDQUIT
GOTO DONE
+15 IF $Y>(IOSL-3)
DO HDR
IF APCDQUIT
GOTO DONE
+16 WRITE !!,"Total Number of Visits: ",APCDTOT
DONE ;
+1 KILL ^XTMP("APCDDVL1",APCDJ,APCDBT),APCDJ,APCDBT
+2 IF $EXTRACT(IOST)="C"
IF IO=IO(0)
SET DIR(0)="EO"
SET DIR("A")="End of report. HIT RETURN"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+3 IF $DATA(IOF)
WRITE @IOF
+4 QUIT
VCNT(V) ;return number of other visits on this date
+1 IF '$GET(V)
QUIT 0
+2 IF '$DATA(^AUPNVSIT(V))
QUIT 0
+3 NEW D,X,Y,C,DATE,END,P
+4 SET P=$PIECE(^AUPNVSIT(V,0),U,5)
+5 SET D=$PIECE($PIECE(^AUPNVSIT(V,0),U),".")
+6 SET (C,C1)=0
SET DATE=(9999999-D)-.0001
SET END=(9999999-D)+.9999999
+7 FOR
SET DATE=$ORDER(^AUPNVSIT("AA",P,DATE))
IF 'DATE!(DATE>END)
QUIT
Begin DoDot:1
+8 SET X=0
FOR
SET X=$ORDER(^AUPNVSIT("AA",P,DATE,X))
IF X'=+X
QUIT
IF X'=V
IF '$PIECE(^AUPNVSIT(X,0),U,11)
SET C=C+1
IF $DATA(^AUPNVPOV("AD",X))
IF $DATA(^AUPNVPRV("AD",X))
SET C1=C1+1
End DoDot:1
+9 QUIT C_U_C1
+10 ;
HDR ;header for report
+1 IF 'APCDPG
GOTO HDR1
+2 IF $EXTRACT(IOST)="C"
IF IO=IO(0)
WRITE !
SET DIR(0)="EO"
DO ^DIR
KILL DIR
IF Y=0!(Y="^")!($DATA(DTOUT))
SET APCDQUIT=1
QUIT
HDR1 ;
+1 IF $DATA(IOF)
WRITE @IOF
SET APCDPG=APCDPG+1
+2 WRITE $PIECE(^VA(200,DUZ,0),U,2),$$CTR($$FMTE^XLFDT(DT)),?71,"Page ",APCDPG,!
+3 WRITE $$CTR($$LOC),!
+4 WRITE $$CTR("CHECKED IN VISITS WITH NO POV (NOT YET CODED)"),!
+5 ;CMI/TUCSON added 11/3/98
NEW %
SET %="Visit dates: "_$$FMTE^XLFDT(APCDBD)_" to "_$$FMTE^XLFDT(APCDED)
WRITE $$CTR(%),!
+6 WRITE "** Last column is the number of other visits on the same day and the",!," # of those visits that are complete",!!
+7 WRITE ?3,"PATIENT NAME",?17," HRN",?23,"VISIT DATE&TIME",?42,"SC",?45,"CL",?48,"HOSPITAL LOC",?64,"PROV",?72,"# visits",!
+8 WRITE $TRANSLATE($JUSTIFY(" ",80)," ","-"),!
+9 QUIT
CTR(X,Y) ;EP - Center X in a field Y wide.
+1 QUIT $JUSTIFY("",$SELECT($DATA(Y):Y,1:IOM)-$LENGTH(X)\2)_X
+2 ;----------
USR() ;EP - Return name of current user from ^VA(200.
+1 QUIT $SELECT($GET(DUZ):$SELECT($DATA(^VA(200,DUZ,0)):$PIECE(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
+2 ;----------
LOC() ;EP - Return location name from file 4 based on DUZ(2).
+1 QUIT $SELECT($GET(DUZ(2)):$SELECT($DATA(^DIC(4,DUZ(2),0)):$PIECE(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
+2 ;----------
INFORM ;let user know what is gong on
+1 IF $DATA(IOF)
WRITE @IOF
+2 WRITE !!,$$CTR($$LOC,80)
+3 WRITE !,$$CTR($$USR,80),!!
+4 FOR I=1:1
SET X=$PIECE($TEXT(INTRO+I),";;",2)
IF X="END"
QUIT
WRITE !,X
+5 KILL I,X
+6 QUIT
INTRO ;;
+1 ;;This report will list all PCC Visits that were created by the
+2 ;;Scheduling Check-In process that do not yet have a Purpose of Visit.
+3 ;;This report will be used to determine if PCC forms have been submitted
+4 ;;for these visits or if an additional visit has been created for this scheduled
+5 ;;visit.
+6 ;;END
