APCLOR1 ; IHS/CMI/LAB - ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;
START ;
D XIT
I '$D(IOF) D HOME^%ZIS
W @(IOF),!!
D INFORM
TYPE ;type of report
S APCLRTYP=""
S DIR(0)="S^L:LAB;P:PHARMACY;R:RADIOLOGY",DIR("A")="What type of ophan visits should be included" KILL DA D ^DIR KILL DIR
G:$D(DIRUT) XIT
S APCLRTYP=Y,APCLRTYE=Y(0)
DATES K APCLED,APCLBD
K DIR W ! S DIR(0)="DO^::EXP",DIR("A")="Enter Beginning Visit Date"
D ^DIR G:Y<1 TYPE S APCLBD=Y
K DIR S DIR(0)="DO^:DT:EXP",DIR("A")="Enter Ending Visit Date"
D ^DIR G:Y<1 TYPE S APCLED=Y
;
I APCLED<APCLBD D G DATES
. W !!,$C(7),"Sorry, Ending Date MUST not be earlier than Beginning Date."
S APCLSD=$$FMADD^XLFDT(APCLBD,-1)_".9999"
;
FAC ;
S APCLLOCT=""
S DIR(0)="S^A:ALL Locations/Facilities;S:One SERVICE UNIT'S Locations/Facilities;O:ONE Location/Facility",DIR("A")="Include Visits to Which Location/Facilities",DIR("B")="A"
S DIR("A")="Enter a code indicating what LOCATIONS/FACILITIES are of interest",DIR("B")="O" K DA D ^DIR K DIR,DA
G:$D(DIRUT) DATES
S APCLLOCT=Y
I APCLLOCT="A" G ZIS
D @APCLLOCT
G:$D(APCLQ) FAC
ZIS ;
DEMO ;
D DEMOCHK^APCLUTL(.APCLDEMO)
I APCLDEMO=-1 G FAC
S DIR(0)="S^P:PRINT Output;B:BROWSE Output on Screen",DIR("A")="Do you wish to ",DIR("B")="P" K DA D ^DIR K DIR
I $D(DIRUT) G XIT
I $G(Y)="B" D BROWSE,XIT Q
S XBRC="PROC^APCLOR1",XBRP="PRINT^APCLOR1",XBNS="APCL",XBRX="XIT^APCLOR1"
D ^XBDBQUE
XIT ;
D EN^XBVK("APCL"),^XBFMK
Q
;
BROWSE ;
S XBRP="VIEWR^XBLM(""PRINT^APCLOR1"")"
S XBNS="APCL",XBRC="PROC^APCLOR1",XBRX="XIT^APCLOR1",XBIOP=0 D ^XBDBQUE
Q
;
PROC ;EP - called from xbdbque
S ^XTMP("APCLOR1",0)=$$FMADD^XLFDT(DT,14)_"^"_DT_"^"_"ORPHANED VISIT REPORT"
S APCLJ=$J,APCLH=$H,APCLCNT=0
K ^XTMP("APCLOR1",APCLJ,APCLH)
;$O through all visits and set for patient once
F S APCLSD=$O(^AUPNVSIT("B",APCLSD)) Q:APCLSD=""!((APCLSD\1)>APCLED) D
.S APCLV=0 F S APCLV=$O(^AUPNVSIT("B",APCLSD,APCLV)) Q:APCLV'=+APCLV I $D(^AUPNVSIT(APCLV,0)),$P(^(0),U,9),'$P(^(0),U,11) D PROC1
.Q
Q
PROC1 ;
I $P(^AUPNVSIT(APCLV,0),U,6)="" Q
I $P(^AUPNVSIT(APCLV,0),U,5)="" Q
Q:$$DEMO^APCLUTL($P(^AUPNVSIT(APCLV,0),U,5),$G(APCLDEMO))
I $P(^AUPNVSIT(APCLV,0),U,7)="E" Q ;exclude events
I $D(^AUPNVPOV("AD",APCLV)),$D(^AUPNVPRV("AD",APCLV)) Q ;coded, not orphaned
I $P(^AUPNVSIT(APCLV,0),U,7)="I",$P(^AUPNVSIT(APCLV,0),U,12)]"" Q ;PER VINA 10-20-04
I APCLRTYP="L",'$D(^AUPNVLAB("AD",APCLV)) Q
I APCLRTYP="R",'$D(^AUPNVRAD("AD",APCLV)) Q
I APCLRTYP="P",'$D(^AUPNVMED("AD",APCLV)) Q
I APCLLOCT="O",$P(^AUPNVSIT(APCLV,0),U,6)'=APCLLOCT("ONE") Q
I APCLLOCT="S",$$VALI^XBDIQ1(9999999.06,$P(^AUPNVSIT(APCLV,0),U,6),.05)'=APCLLOCT("SU") Q
S ^XTMP("APCLOR1",APCLJ,APCLH,"VISITS",APCLV)="",APCLCNT=APCLCNT+1
Q
D(D) ;
I $G(D)="" Q ""
Q $E(D,4,5)_"/"_$E(D,6,7)_"/"_$E(D,2,3)
CTR(X,Y) ;EP - Center X in a field Y wide.
Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
;----------
EOP ;EP - End of page.
Q:$E(IOST)'="C"
Q:$D(ZTQUEUED)!'(IOT="TRM")!$D(IO("S"))
NEW DIR
K DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
S DIR("A")="End of report. Press Enter",DIR(0)="E" D ^DIR
Q
;----------
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 ;inform user what this report is all about
W !,$$CTR($$LOC)
W !!,"This report will list all visits that are 'orphan visits'. You will be asked",!,"to select whether you want orpaned lab, pharmacy or radiology visits."
W !,"If you select lab, you will get all visits with no primary provider or",!,"pov entered that have a lab entry attached to them. The same is true for",!,"pharmacy or radiology.",!
W !!,"If a visit has both a V LAB and a V RADIOLOGY the visit would be included",!,"in each report.",!!
Q
O ;one location
S DIC="^AUTTLOC(",DIC(0)="AEMQ",DIC("A")="Which LOCATION: " D ^DIC K DIC
I Y=-1 S APCLQ="" Q
S APCLLOCT("ONE")=+Y
Q
S ;all communities within APCLSU su
S DIC="^AUTTSU(",DIC("B")=$$VAL^XBDIQ1(9999999.06,DUZ(2),.05),DIC(0)="AEMQ",DIC("A")="Which SERVICE UNIT: " D ^DIC K DIC
I Y=-1 S APCLQ="" Q
S APCLLOCT("SU")=+Y
Q
;
PRINT ;EP - called from xbdbque
K APCLQ S APCLPG=0 D HEADER
I '$D(^XTMP("APCLOR1",APCLJ,APCLH)) D HEADER W !!,"NO DATA TO REPORT",! G DONE
W !!,"TOTAL NUMBER OF VISITS FOUND: ",APCLCNT,!!
S APCLV=0 F S APCLV=$O(^XTMP("APCLOR1",APCLJ,APCLH,"VISITS",APCLV)) Q:APCLV'=+APCLV!($D(APCLQ)) D
.I $Y>(IOSL-3) D HEADER Q:$D(APCLQ)
.S APCLVREC=^AUPNVSIT(APCLV,0)
.W !,$$HRN^AUPNPAT($P(APCLVREC,U,5),DUZ(2),2),?12,$E($P(^DPT($P(APCLVREC,U,5),0),U),1,20),?35,$$FMTE^XLFDT($P($P(APCLVREC,U),"."))
.W ?48,$P($$FMTE^XLFDT($P(APCLVREC,U),"2P")," ",2),?55,$P(APCLVREC,U,7),?59,$P(APCLVREC,U,3),?62,$P(^AUTTLOC($P(APCLVREC,U,6),0),U,7),?68,$$NLAB(APCLV),?73,$$NRX(APCLV),?77,$$NRAD(APCLV)
DONE ;
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
K APCLTS,APCLS,APCLM,APCLET
K ^XTMP("APCLOR1",APCLJ,APCLH),APCLJ,APCLH
Q
;
NLAB(V) ;
NEW X,C
S (X,C)=0 F S X=$O(^AUPNVLAB("AD",V,X)) Q:X'=+X S C=C+1
Q C
NRX(V) ;
NEW X,C
S (X,C)=0 F S X=$O(^AUPNVMED("AD",V,X)) Q:X'=+X S C=C+1
Q C
NRAD(V) ;
NEW X,C
S (X,C)=0 F S X=$O(^AUPNVRAD("AD",V,X)) Q:X'=+X S C=C+1
Q C
G:'APCLPG HEADER1
K DIR I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S APCLQ="" Q
W:$D(IOF) @IOF S APCLPG=APCLPG+1
W !?3,$P(^VA(200,DUZ,0),U,2),?35,$$FMTE^XLFDT(DT),?70,"Page ",APCLPG,!
W !,$$CTR("INCOMPLETE "_APCLRTYE_" VISITS",80),!
S X="Visit Dates: "_$$FMTE^XLFDT(APCLBD)_" to "_$$FMTE^XLFDT(APCLED) W $$CTR(X,80),!
W !?68,"#",?72,"#",?76,"#"
W !,"HRN",?12,"PATIENT NAME",?37,"DATE",?48,"TIME",?54,"SC",?57,"TYPE",?62,"LOC",?67,"LAB",?71,"RX",?75,"RAD"
W !,$TR($J("",80)," ","-")
Q
APCLOR1 ; IHS/CMI/LAB - ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;
START ;
+1 DO XIT
+2 IF '$DATA(IOF)
DO HOME^%ZIS
+3 WRITE @(IOF),!!
+4 DO INFORM
TYPE ;type of report
+1 SET APCLRTYP=""
+2 SET DIR(0)="S^L:LAB;P:PHARMACY;R:RADIOLOGY"
SET DIR("A")="What type of ophan visits should be included"
KILL DA
DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)
GOTO XIT
+4 SET APCLRTYP=Y
SET APCLRTYE=Y(0)
DATES KILL APCLED,APCLBD
+1 KILL DIR
WRITE !
SET DIR(0)="DO^::EXP"
SET DIR("A")="Enter Beginning Visit Date"
+2 DO ^DIR
IF Y<1
GOTO TYPE
SET APCLBD=Y
+3 KILL DIR
SET DIR(0)="DO^:DT:EXP"
SET DIR("A")="Enter Ending Visit Date"
+4 DO ^DIR
IF Y<1
GOTO TYPE
SET APCLED=Y
+5 ;
+6 IF APCLED<APCLBD
Begin DoDot:1
+7 WRITE !!,$CHAR(7),"Sorry, Ending Date MUST not be earlier than Beginning Date."
End DoDot:1
GOTO DATES
+8 SET APCLSD=$$FMADD^XLFDT(APCLBD,-1)_".9999"
+9 ;
FAC ;
+1 SET APCLLOCT=""
+2 SET DIR(0)="S^A:ALL Locations/Facilities;S:One SERVICE UNIT'S Locations/Facilities;O:ONE Location/Facility"
SET DIR("A")="Include Visits to Which Location/Facilities"
SET DIR("B")="A"
+3 SET DIR("A")="Enter a code indicating what LOCATIONS/FACILITIES are of interest"
SET DIR("B")="O"
KILL DA
DO ^DIR
KILL DIR,DA
+4 IF $DATA(DIRUT)
GOTO DATES
+5 SET APCLLOCT=Y
+6 IF APCLLOCT="A"
GOTO ZIS
+7 DO @APCLLOCT
+8 IF $DATA(APCLQ)
GOTO FAC
ZIS ;
DEMO ;
+1 DO DEMOCHK^APCLUTL(.APCLDEMO)
+2 IF APCLDEMO=-1
GOTO FAC
+3 SET DIR(0)="S^P:PRINT Output;B:BROWSE Output on Screen"
SET DIR("A")="Do you wish to "
SET DIR("B")="P"
KILL DA
DO ^DIR
KILL DIR
+4 IF $DATA(DIRUT)
GOTO XIT
+5 IF $GET(Y)="B"
DO BROWSE
DO XIT
QUIT
+6 SET XBRC="PROC^APCLOR1"
SET XBRP="PRINT^APCLOR1"
SET XBNS="APCL"
SET XBRX="XIT^APCLOR1"
+7 DO ^XBDBQUE
XIT ;
+1 DO EN^XBVK("APCL")
DO ^XBFMK
+2 QUIT
+3 ;
BROWSE ;
+1 SET XBRP="VIEWR^XBLM(""PRINT^APCLOR1"")"
+2 SET XBNS="APCL"
SET XBRC="PROC^APCLOR1"
SET XBRX="XIT^APCLOR1"
SET XBIOP=0
DO ^XBDBQUE
+3 QUIT
+4 ;
PROC ;EP - called from xbdbque
+1 SET ^XTMP("APCLOR1",0)=$$FMADD^XLFDT(DT,14)_"^"_DT_"^"_"ORPHANED VISIT REPORT"
+2 SET APCLJ=$JOB
SET APCLH=$HOROLOG
SET APCLCNT=0
+3 KILL ^XTMP("APCLOR1",APCLJ,APCLH)
+4 ;$O through all visits and set for patient once
+5 FOR
SET APCLSD=$ORDER(^AUPNVSIT("B",APCLSD))
IF APCLSD=""!((APCLSD\1)>APCLED)
QUIT
Begin DoDot:1
+6 SET APCLV=0
FOR
SET APCLV=$ORDER(^AUPNVSIT("B",APCLSD,APCLV))
IF APCLV'=+APCLV
QUIT
IF $DATA(^AUPNVSIT(APCLV,0))
IF $PIECE(^(0),U,9)
IF '$PIECE(^(0),U,11)
DO PROC1
+7 QUIT
End DoDot:1
+8 QUIT
PROC1 ;
+1 IF $PIECE(^AUPNVSIT(APCLV,0),U,6)=""
QUIT
+2 IF $PIECE(^AUPNVSIT(APCLV,0),U,5)=""
QUIT
+3 IF $$DEMO^APCLUTL($PIECE(^AUPNVSIT(APCLV,0),U,5),$GET(APCLDEMO))
QUIT
+4 ;exclude events
IF $PIECE(^AUPNVSIT(APCLV,0),U,7)="E"
QUIT
+5 ;coded, not orphaned
IF $DATA(^AUPNVPOV("AD",APCLV))
IF $DATA(^AUPNVPRV("AD",APCLV))
QUIT
+6 ;PER VINA 10-20-04
IF $PIECE(^AUPNVSIT(APCLV,0),U,7)="I"
IF $PIECE(^AUPNVSIT(APCLV,0),U,12)]""
QUIT
+7 IF APCLRTYP="L"
IF '$DATA(^AUPNVLAB("AD",APCLV))
QUIT
+8 IF APCLRTYP="R"
IF '$DATA(^AUPNVRAD("AD",APCLV))
QUIT
+9 IF APCLRTYP="P"
IF '$DATA(^AUPNVMED("AD",APCLV))
QUIT
+10 IF APCLLOCT="O"
IF $PIECE(^AUPNVSIT(APCLV,0),U,6)'=APCLLOCT("ONE")
QUIT
+11 IF APCLLOCT="S"
IF $$VALI^XBDIQ1(9999999.06,$PIECE(^AUPNVSIT(APCLV,0),U,6),.05)'=APCLLOCT("SU")
QUIT
+12 SET ^XTMP("APCLOR1",APCLJ,APCLH,"VISITS",APCLV)=""
SET APCLCNT=APCLCNT+1
+13 QUIT
D(D) ;
+1 IF $GET(D)=""
QUIT ""
+2 QUIT $EXTRACT(D,4,5)_"/"_$EXTRACT(D,6,7)_"/"_$EXTRACT(D,2,3)
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 ;----------
EOP ;EP - End of page.
+1 IF $EXTRACT(IOST)'="C"
QUIT
+2 IF $DATA(ZTQUEUED)!'(IOT="TRM")!$DATA(IO("S"))
QUIT
+3 NEW DIR
+4 KILL DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
+5 SET DIR("A")="End of report. Press Enter"
SET DIR(0)="E"
DO ^DIR
+6 QUIT
+7 ;----------
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 ;inform user what this report is all about
+1 WRITE !,$$CTR($$LOC)
+2 WRITE !!,"This report will list all visits that are 'orphan visits'. You will be asked",!,"to select whether you want orpaned lab, pharmacy or radiology visits."
+3 WRITE !,"If you select lab, you will get all visits with no primary provider or",!,"pov entered that have a lab entry attached to them. The same is true for",!,"pharmacy or radiology.",!
+4 WRITE !!,"If a visit has both a V LAB and a V RADIOLOGY the visit would be included",!,"in each report.",!!
+5 QUIT
O ;one location
+1 SET DIC="^AUTTLOC("
SET DIC(0)="AEMQ"
SET DIC("A")="Which LOCATION: "
DO ^DIC
KILL DIC
+2 IF Y=-1
SET APCLQ=""
QUIT
+3 SET APCLLOCT("ONE")=+Y
+4 QUIT
S ;all communities within APCLSU su
+1 SET DIC="^AUTTSU("
SET DIC("B")=$$VAL^XBDIQ1(9999999.06,DUZ(2),.05)
SET DIC(0)="AEMQ"
SET DIC("A")="Which SERVICE UNIT: "
DO ^DIC
KILL DIC
+2 IF Y=-1
SET APCLQ=""
QUIT
+3 SET APCLLOCT("SU")=+Y
+4 QUIT
+5 ;
PRINT ;EP - called from xbdbque
+1 KILL APCLQ
SET APCLPG=0
DO HEADER
+2 IF '$DATA(^XTMP("APCLOR1",APCLJ,APCLH))
DO HEADER
WRITE !!,"NO DATA TO REPORT",!
GOTO DONE
+3 WRITE !!,"TOTAL NUMBER OF VISITS FOUND: ",APCLCNT,!!
+4 SET APCLV=0
FOR
SET APCLV=$ORDER(^XTMP("APCLOR1",APCLJ,APCLH,"VISITS",APCLV))
IF APCLV'=+APCLV!($DATA(APCLQ))
QUIT
Begin DoDot:1
+5 IF $Y>(IOSL-3)
DO HEADER
IF $DATA(APCLQ)
QUIT
+6 SET APCLVREC=^AUPNVSIT(APCLV,0)
+7 WRITE !,$$HRN^AUPNPAT($PIECE(APCLVREC,U,5),DUZ(2),2),?12,$EXTRACT($PIECE(^DPT($PIECE(APCLVREC,U,5),0),U),1,20),?35,$$FMTE^XLFDT($PIECE($PIECE(APCLVREC,U),"."))
+8 WRITE ?48,$PIECE($$FMTE^XLFDT($PIECE(APCLVREC,U),"2P")," ",2),?55,$PIECE(APCLVREC,U,7),?59,$PIECE(APCLVREC,U,3),?62,$PIECE(^AUTTLOC($PIECE(APCLVREC,U,6),0),U,7),?68,$$NLAB(APCLV),?73,$$NRX(APCLV),?77,$$NRAD(APCLV)
End DoDot:1
DONE ;
+1 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
+2 IF $DATA(IOF)
WRITE @IOF
+3 KILL APCLTS,APCLS,APCLM,APCLET
+4 KILL ^XTMP("APCLOR1",APCLJ,APCLH),APCLJ,APCLH
+5 QUIT
+6 ;
NLAB(V) ;
+1 NEW X,C
+2 SET (X,C)=0
FOR
SET X=$ORDER(^AUPNVLAB("AD",V,X))
IF X'=+X
QUIT
SET C=C+1
+3 QUIT C
NRX(V) ;
+1 NEW X,C
+2 SET (X,C)=0
FOR
SET X=$ORDER(^AUPNVMED("AD",V,X))
IF X'=+X
QUIT
SET C=C+1
+3 QUIT C
NRAD(V) ;
+1 NEW X,C
+2 SET (X,C)=0
FOR
SET X=$ORDER(^AUPNVRAD("AD",V,X))
IF X'=+X
QUIT
SET C=C+1
+3 QUIT C
+1 IF 'APCLPG
GOTO HEADER1
+2 KILL DIR
IF $EXTRACT(IOST)="C"
IF IO=IO(0)
WRITE !
SET DIR(0)="EO"
DO ^DIR
KILL DIR
IF Y=0!(Y="^")!($DATA(DTOUT))
SET APCLQ=""
QUIT
+1 IF $DATA(IOF)
WRITE @IOF
SET APCLPG=APCLPG+1
+2 WRITE !?3,$PIECE(^VA(200,DUZ,0),U,2),?35,$$FMTE^XLFDT(DT),?70,"Page ",APCLPG,!
+3 WRITE !,$$CTR("INCOMPLETE "_APCLRTYE_" VISITS",80),!
+4 SET X="Visit Dates: "_$$FMTE^XLFDT(APCLBD)_" to "_$$FMTE^XLFDT(APCLED)
WRITE $$CTR(X,80),!
+5 WRITE !?68,"#",?72,"#",?76,"#"
+6 WRITE !,"HRN",?12,"PATIENT NAME",?37,"DATE",?48,"TIME",?54,"SC",?57,"TYPE",?62,"LOC",?67,"LAB",?71,"RX",?75,"RAD"
+7 WRITE !,$TRANSLATE($JUSTIFY("",80)," ","-")
+8 QUIT
