APCDDVL3 ; IHS/CMI/LAB - report on checked in visits with no pov ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;IHS/CMI/LAB - patch 1 Y2K
;
;
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
;
SORT ;
S APCDCSRT=""
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 ED
S APCDCSRT=Y
DEMO ;
D DEMOCHK^APCLUTL(.APCDDEMO)
I APCDDEMO=-1 G BD
ZIS ;call to XBDBQUE
S XBRP="PRINT^APCDDVL3",XBRC="PROCESS^APCDDVL3",XBRX="EOJ^APCDDVL3",XBNS="APCD"
D ^XBDBQUE
D EOJ
Q
;
EOJ ;
D EN^XBVK("APCD")
Q
PROCESS ;EP - called from XBDBQUE
S ^XTMP("APCDDVL3",0)=$$FMADD^XLFDT(DT,14)_"^"_DT_"^"_"APCD - 12:00 VISITS W NO BILL LINK"
S APCDJ=$J,APCDBT=$H
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 $P($P(^AUPNVSIT(APCDV,0),U),".",2)'=12 Q ;no a 12:00 visit
.. Q:$$DEMO^APCLUTL($P(^AUPNVSIT(APCDV,0),U,5),APCDDEMO)
.. I $P(^AUPNVSIT(APCDV,0),U,28)]"" Q ;has billing link
.. I $P(^AUPNVSIT(APCDV,0),U,6)'=DUZ(2) Q ;another facilities visit
.. ;I $$PRIMPROV^APCLV(APCDV)]"",$D(^AUPNVPOV("AD",APCDV)) Q ;COMPLETE VISIT
.. Q:"AORS"'[$P(^AUPNVSIT(APCDV,0),U,7)
.. S APCDSORT="" D GETSORT I APCDSORT="" S APCDSORT="??"
.. S ^XTMP("APCDDVL3",APCDJ,APCDBT,"VISITS",APCDSORT,APCDV)=""
.. Q
. Q
Q
GETSORT ;get sort value
I APCDCSRT="D" S APCDSORT=$P(^AUPNVSIT(APCDV,0),U) Q
I APCDCSRT="C" S APCDSORT=$$CLINIC^APCLV(APCDV,"C") Q ;clinic code
;hrn sort values
S APCDSORT=$$HRN^AUPNPAT($P(^AUPNVSIT(APCDV,0),U,5),DUZ(2))
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("APCDDVL3",APCDJ,APCDBT)) D HDR W !!,"NO DATA TO REPORT",! G DONE
S APCDSORT="" F S APCDSORT=$O(^XTMP("APCDDVL3",APCDJ,APCDBT,"VISITS",APCDSORT)) Q:APCDSORT=""!(APCDQUIT) D
. S APCDV=0 F S APCDV=$O(^XTMP("APCDDVL3",APCDJ,APCDBT,"VISITS",APCDSORT,APCDV)) Q:APCDV'=+APCDV!(APCDQUIT) D
.. I $Y>(IOSL-4) D HDR Q:APCDQUIT
.. S APCDVR=^AUPNVSIT(APCDV,0)
.. ;beginning Y2K - change 2 parameter to 5
.. ;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),"2"),?38,$P(APCDVR,U,7),?40,$$CLINIC^APCLV(APCDV,"C") ;Y2000
.. 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),"5"),?38,$P(APCDVR,U,7),?40,$$CLINIC^APCLV(APCDV,"C") ;Y2000
.. ;end Y2K
.. K APCDX,APCDD D DE
.. S APCDY=0 F S APCDY=$O(APCDX(APCDY)) Q:APCDY'=+APCDY!(APCDQUIT) D
... I $Y>(IOSL-3) D HDR Q:APCDQUIT
... W:APCDY>1 !
... ;beginning Y2K
... ;W ?43,$P(APCDX(APCDY),U),?54,$E($P(APCDX(APCDY),U,2),1,15),?70,$$FMTE^XLFDT($P(APCDX(APCDY),U,3),"2") ;Y2000
... W ?43,$P(APCDX(APCDY),U),?54,$E($P(APCDX(APCDY),U,2),1,15),?70,$$FMTE^XLFDT($P(APCDX(APCDY),U,3),"5") ;Y2000
... ;end Y2K
.. S APCDP=$P(^AUPNVSIT(APCDV,0),U,5)
.. S APCDY=0,APCDORDT="" F S APCDY=$O(APCDX(APCDY)) Q:APCDY'=+APCDY!(APCDORDT) S APCDORDT=$P(APCDX(APCDY),U,3)
.. Q:APCDORDT=""
.. S C=0,APCDDATE=(9999999-APCDORDT)-.0001,END=(9999999-APCDORDT)+.9999999
.. F S APCDDATE=$O(^AUPNVSIT("AA",APCDP,APCDDATE)) Q:'APCDDATE!(APCDDATE>END)!(APCDQUIT) D
... S APCDX=0 F S APCDX=$O(^AUPNVSIT("AA",APCDP,APCDDATE,APCDX)) Q:APCDX'=+APCDX!(APCDQUIT) I APCDX'=APCDV,'$P(^AUPNVSIT(APCDX,0),U,11) S C=C+1 D
.... I $Y>(IOSL-3) D HDR Q:(APCDQUIT)
.... W ! W:C=1 ?3,"Order date vsts: "
.... ;beginning Y2K
.... ;W ?21,$$FMTE^XLFDT($P(^AUPNVSIT(APCDX,0),U),"2"),?38,$P(^AUPNVSIT(APCDX,0),U,7),?39,$$CLINIC^APCLV(APCDX,"C"),?42,$E($$VAL^XBDIQ1(9000010,APCDX,.22),1,15),?58,$E($$PRIMPROV^APCLV(APCDX,"N"),1,15),?74,$$PRIMPOV^APCLV(APCDX,"C") ;Y2000
.... W ?21,$$FMTE^XLFDT($P(^AUPNVSIT(APCDX,0),U),"5"),?38,$P(^AUPNVSIT(APCDX,0),U,7),?39,$$CLINIC^APCLV(APCDX,"C"),?42,$E($$VAL^XBDIQ1(9000010,APCDX,.22),1,15),?58,$E($$PRIMPROV^APCLV(APCDX,"N"),1,15),?74,$$PRIMPOV^APCLV(APCDX,"C") ;Y2000
.... ;end Y2K
.... Q
... Q
.. Q
.Q
DONE ;
K ^XTMP("APCDDVL3",APCDJ,APCDBT),APCDJ,APCDBT
I $E(IOST)="C",IO=IO(0) S DIR(0)="EO",DIR("A")="End of report. PRESS ENTER" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
W:$D(IOF) @IOF
Q
DTC(V) ;any v tran code with an ordering provider? 1 or 0
I '$G(V) Q 0
I '$D(^AUPNVSIT(V,0)) Q 0
I '$D(^AUPNVTC("AD",V)) Q 0
NEW C
S (X,C)=0 F S X=$O(^AUPNVTC("AD",V,X)) Q:X'=+X I $P($G(^AUPNVTC(X,12)),U,11) S C=C+1
Q C
;
DE ;EP;FIND DEP ENTRIES
K APCDX,APCDD S APCDC=0
S APCDVFLE=9000010 F S APCDVFLE=$O(^DIC(APCDVFLE)) Q:APCDVFLE>9000010.99!(APCDVFLE'=+APCDVFLE) D DE2
Q
;
DE2 ;
S APCDVDG=^DIC(APCDVFLE,0,"GL"),APCDVIGR=APCDVDG_"""AD"",APCDV,APCDVDFN)"
S APCDVDFN="" I $O(@APCDVIGR)]"" S APCDC=APCDC+1,APCDX(APCDC)=$E($P($P(^DIC(APCDVFLE,0),U),"V ",2),1,3)_"'s" S Y=$O(@APCDVIGR) S $P(APCDX(APCDC),U,3)=$$VALI^XBDIQ1(APCDVFLE,Y,1211),$P(APCDX(APCDC),U,2)=$$VAL^XBDIQ1(APCDVFLE,Y,1202)
Q
;
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("12:00 Visits with No Billing Link"),!
W !?3,"PATIENT NAME",?17,"HRN",?22,"VISIT DATE",?37,"SC",?40,"CL",?43,"V FILE'S",?54,"ORDER PROV",?70,"ORDER DATE"
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 visits with a time of 12:00 that have no billing
;;link. Only visits with a service category of A,O,R and s are reviewed.
;;Only visits to the location list above are reviewed.
;;
;;END
APCDDVL3 ; IHS/CMI/LAB - report on checked in visits with no pov ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;IHS/CMI/LAB - patch 1 Y2K
+3 ;
+4 ;
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 ;
SORT ;
+1 SET APCDCSRT=""
+2 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
+3 IF $DATA(DIRUT)
GOTO ED
+4 SET APCDCSRT=Y
DEMO ;
+1 DO DEMOCHK^APCLUTL(.APCDDEMO)
+2 IF APCDDEMO=-1
GOTO BD
ZIS ;call to XBDBQUE
+1 SET XBRP="PRINT^APCDDVL3"
SET XBRC="PROCESS^APCDDVL3"
SET XBRX="EOJ^APCDDVL3"
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("APCDDVL3",0)=$$FMADD^XLFDT(DT,14)_"^"_DT_"^"_"APCD - 12:00 VISITS W NO BILL LINK"
+2 SET APCDJ=$JOB
SET APCDBT=$HOROLOG
+3 SET APCDT=APCDBD-.0001
SET APCDEND=APCDED+.2400
+4 FOR
SET APCDT=$ORDER(^AUPNVSIT("B",APCDT))
IF 'APCDT!(APCDT>APCDEND)
QUIT
Begin DoDot:1
+5 SET APCDV=0
+6 FOR
SET APCDV=$ORDER(^AUPNVSIT("B",APCDT,APCDV))
IF 'APCDV
QUIT
Begin DoDot:2
+7 ;no a 12:00 visit
IF $PIECE($PIECE(^AUPNVSIT(APCDV,0),U),".",2)'=12
QUIT
+8 IF $$DEMO^APCLUTL($PIECE(^AUPNVSIT(APCDV,0),U,5),APCDDEMO)
QUIT
+9 ;has billing link
IF $PIECE(^AUPNVSIT(APCDV,0),U,28)]""
QUIT
+10 ;another facilities visit
IF $PIECE(^AUPNVSIT(APCDV,0),U,6)'=DUZ(2)
QUIT
+11 ;I $$PRIMPROV^APCLV(APCDV)]"",$D(^AUPNVPOV("AD",APCDV)) Q ;COMPLETE VISIT
+12 IF "AORS"'[$PIECE(^AUPNVSIT(APCDV,0),U,7)
QUIT
+13 SET APCDSORT=""
DO GETSORT
IF APCDSORT=""
SET APCDSORT="??"
+14 SET ^XTMP("APCDDVL3",APCDJ,APCDBT,"VISITS",APCDSORT,APCDV)=""
+15 QUIT
End DoDot:2
+16 QUIT
End DoDot:1
+17 QUIT
GETSORT ;get sort value
+1 IF APCDCSRT="D"
SET APCDSORT=$PIECE(^AUPNVSIT(APCDV,0),U)
QUIT
+2 ;clinic code
IF APCDCSRT="C"
SET APCDSORT=$$CLINIC^APCLV(APCDV,"C")
QUIT
+3 ;hrn sort values
+4 SET APCDSORT=$$HRN^AUPNPAT($PIECE(^AUPNVSIT(APCDV,0),U,5),DUZ(2))
+5 IF APCDCSRT'="T"
QUIT
+6 SET APCDSORT=APCDSORT+10000000
SET APCDSORT=$EXTRACT(APCDSORT,7,8)_"-"_+$EXTRACT(APCDSORT,2,8)
+7 QUIT
PRINT ;EP - called from XBDBQUE
+1 SET APCDQUIT=""
SET APCDPG=0
DO HDR
+2 IF '$DATA(^XTMP("APCDDVL3",APCDJ,APCDBT))
DO HDR
WRITE !!,"NO DATA TO REPORT",!
GOTO DONE
+3 SET APCDSORT=""
FOR
SET APCDSORT=$ORDER(^XTMP("APCDDVL3",APCDJ,APCDBT,"VISITS",APCDSORT))
IF APCDSORT=""!(APCDQUIT)
QUIT
Begin DoDot:1
+4 SET APCDV=0
FOR
SET APCDV=$ORDER(^XTMP("APCDDVL3",APCDJ,APCDBT,"VISITS",APCDSORT,APCDV))
IF APCDV'=+APCDV!(APCDQUIT)
QUIT
Begin DoDot:2
+5 IF $Y>(IOSL-4)
DO HDR
IF APCDQUIT
QUIT
+6 SET APCDVR=^AUPNVSIT(APCDV,0)
+7 ;beginning Y2K - change 2 parameter to 5
+8 ;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),"2"),?38,$P(APCDVR,U,7),?40,$$CLINIC^APCLV(APCDV,"C") ;Y2000
+9 ;Y2000
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),"5"),?38,$PIECE(APCDVR,U,7),?40,$$CLINIC^APCLV(APCDV,"C")
+10 ;end Y2K
+11 KILL APCDX,APCDD
DO DE
+12 SET APCDY=0
FOR
SET APCDY=$ORDER(APCDX(APCDY))
IF APCDY'=+APCDY!(APCDQUIT)
QUIT
Begin DoDot:3
+13 IF $Y>(IOSL-3)
DO HDR
IF APCDQUIT
QUIT
+14 IF APCDY>1
WRITE !
+15 ;beginning Y2K
+16 ;W ?43,$P(APCDX(APCDY),U),?54,$E($P(APCDX(APCDY),U,2),1,15),?70,$$FMTE^XLFDT($P(APCDX(APCDY),U,3),"2") ;Y2000
+17 ;Y2000
WRITE ?43,$PIECE(APCDX(APCDY),U),?54,$EXTRACT($PIECE(APCDX(APCDY),U,2),1,15),?70,$$FMTE^XLFDT($PIECE(APCDX(APCDY),U,3),"5")
+18 ;end Y2K
End DoDot:3
+19 SET APCDP=$PIECE(^AUPNVSIT(APCDV,0),U,5)
+20 SET APCDY=0
SET APCDORDT=""
FOR
SET APCDY=$ORDER(APCDX(APCDY))
IF APCDY'=+APCDY!(APCDORDT)
QUIT
SET APCDORDT=$PIECE(APCDX(APCDY),U,3)
+21 IF APCDORDT=""
QUIT
+22 SET C=0
SET APCDDATE=(9999999-APCDORDT)-.0001
SET END=(9999999-APCDORDT)+.9999999
+23 FOR
SET APCDDATE=$ORDER(^AUPNVSIT("AA",APCDP,APCDDATE))
IF 'APCDDATE!(APCDDATE>END)!(APCDQUIT)
QUIT
Begin DoDot:3
+24 SET APCDX=0
FOR
SET APCDX=$ORDER(^AUPNVSIT("AA",APCDP,APCDDATE,APCDX))
IF APCDX'=+APCDX!(APCDQUIT)
QUIT
IF APCDX'=APCDV
IF '$PIECE(^AUPNVSIT(APCDX,0),U,11)
SET C=C+1
Begin DoDot:4
+25 IF $Y>(IOSL-3)
DO HDR
IF (APCDQUIT)
QUIT
+26 WRITE !
IF C=1
WRITE ?3,"Order date vsts: "
+27 ;beginning Y2K
+28 ;W ?21,$$FMTE^XLFDT($P(^AUPNVSIT(APCDX,0),U),"2"),?38,$P(^AUPNVSIT(APCDX,0),U,7),?39,$$CLINIC^APCLV(APCDX,"C"),?42,$E($$VAL^XBDIQ1(9000010,APCDX,.22),1,15),?58,$E($$PRIMPROV^APCLV(APCDX,"N"),1,15),?74,$$PRIMPOV^APCLV(APCDX,"C") ;Y2000
+29 ;Y2000
WRITE ?21,$$FMTE^XLFDT($PIECE(^AUPNVSIT(APCDX,0),U),"5"),?38,$PIECE(^AUPNVSIT(APCDX,0),U,7),?39,$$CLINIC^APCLV(APCDX,"C"),?42,$EXTRACT($$VAL^XBDIQ1(9000010,APCDX,.22),1,15),?58,$EXTRACT($$PRIMPROV^APCLV(A
PCDX,"N"),1,15),?74,$$PRIMPOV^APCLV(APCDX,"C")
+30 ;end Y2K
+31 QUIT
End DoDot:4
+32 QUIT
End DoDot:3
+33 QUIT
End DoDot:2
+34 QUIT
End DoDot:1
DONE ;
+1 KILL ^XTMP("APCDDVL3",APCDJ,APCDBT),APCDJ,APCDBT
+2 IF $EXTRACT(IOST)="C"
IF IO=IO(0)
SET DIR(0)="EO"
SET DIR("A")="End of report. PRESS ENTER"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+3 IF $DATA(IOF)
WRITE @IOF
+4 QUIT
DTC(V) ;any v tran code with an ordering provider? 1 or 0
+1 IF '$GET(V)
QUIT 0
+2 IF '$DATA(^AUPNVSIT(V,0))
QUIT 0
+3 IF '$DATA(^AUPNVTC("AD",V))
QUIT 0
+4 NEW C
+5 SET (X,C)=0
FOR
SET X=$ORDER(^AUPNVTC("AD",V,X))
IF X'=+X
QUIT
IF $PIECE($GET(^AUPNVTC(X,12)),U,11)
SET C=C+1
+6 QUIT C
+7 ;
DE ;EP;FIND DEP ENTRIES
+1 KILL APCDX,APCDD
SET APCDC=0
+2 SET APCDVFLE=9000010
FOR
SET APCDVFLE=$ORDER(^DIC(APCDVFLE))
IF APCDVFLE>9000010.99!(APCDVFLE'=+APCDVFLE)
QUIT
DO DE2
+3 QUIT
+4 ;
DE2 ;
+1 SET APCDVDG=^DIC(APCDVFLE,0,"GL")
SET APCDVIGR=APCDVDG_"""AD"",APCDV,APCDVDFN)"
+2 SET APCDVDFN=""
IF $ORDER(@APCDVIGR)]""
SET APCDC=APCDC+1
SET APCDX(APCDC)=$EXTRACT($PIECE($PIECE(^DIC(APCDVFLE,0),U),"V ",2),1,3)_"'s"
SET Y=$ORDER(@APCDVIGR)
SET $PIECE(APCDX(APCDC),U,3)=$$VALI^XBDIQ1(APCDVFLE,Y,1211)
SET $PIECE(APCDX(APCDC),U,2)=$$VAL^XBDIQ1(APCDVFLE,Y,1202)
+3 QUIT
+4 ;
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("12:00 Visits with No Billing Link"),!
+5 WRITE !?3,"PATIENT NAME",?17,"HRN",?22,"VISIT DATE",?37,"SC",?40,"CL",?43,"V FILE'S",?54,"ORDER PROV",?70,"ORDER DATE"
+6 WRITE $TRANSLATE($JUSTIFY(" ",80)," ","-"),!
+7 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 visits with a time of 12:00 that have no billing
+2 ;;link. Only visits with a service category of A,O,R and s are reviewed.
+3 ;;Only visits to the location list above are reviewed.
+4 ;;
+5 ;;END
