APCDVLST ; IHS/CMI/LAB - VISIT LIST BY PATIENT ;
;;2.0;IHS PCC SUITE;**11**;MAY 14, 2009;Build 58
W:$D(IOF) @IOF W !,"This routine will list all Visits for a Selected Patient in a",!,"specified Posting Date or Visit Date Range.",!
;
RDPV ; Determine to run by Posting date or Visit date
S APCDBEEP=$C(7)_$C(7),APCDSITE="" S:$D(DUZ(2)) APCDSITE=DUZ(2)
I '$D(DUZ(2)) S APCDSITE=+^AUTTSITE(1,0)
S DIR(0)="S^1:Posting Date;2:Visit Date",DIR("A")="Run Report by",DIR("B")="P" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) G EOJ
S Y=$E(Y),APCDX=$S(Y=1:"P",Y=2:"V",1:Y)
GETDATES ;
BD ;get beginning date
W ! S DIR(0)="D^:DT:EP",DIR("A")="Enter beginning "_$S(APCDX="P":"Posting",APCDX="V":"Visit",1:"Posting")_" Date for Search" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
S APCDBD=Y
I $D(DIRUT) G EOJ
S APCDBD=Y D DD^%DT S APCDBDD=Y
ED ;get ending date
W ! S DIR(0)="DA^"_APCDBD_":DT:EP",DIR("A")="Enter ending "_$S(APCDX="P":"Posting",APCDX="V":"Visit",1:"Posting")_" Date for Search: " S Y=APCDBD D DD^%DT S DIR("B")=Y,Y="" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) G BD
S APCDED=Y D DD^%DT S APCDEDD=Y
S X1=APCDBD,X2=-1 D C^%DTC S APCDSD=X
;
GETPAT ; GET PATIENT
K AUPNDOB,AUPNDOD,AUPNSEX
W !
S AUPNLK("INAC")=""
S AUPNPAT=""
S DIC="^AUPNPAT(",DIC(0)="AEMQ" D ^DIC K DIC
G:Y<0 EOJ
S AUPNPAT=+Y
BRPR ;
S DIR(0)="SO^B:BROWSE Output on Screen;P:PRINT Output to Printer",DIR("A")="Do you want to",DIR("B")="B" K DA D ^DIR K DIR
G:$D(DIRUT) GETPAT
I Y="B" D BROWSE,EOJ Q
S XBRP="DRIVER^APCDVLST",XBRC="PROC^APCDVLST",XBRX="EOJ^APCDVLST",XBNS="APCD;AUPN"
D ^XBDBQUE
D EOJ
Q
;
DRIVER ; Driver
S APCDF=1
D @APCDX
Q
;
PROC ;EP - called from xbdbque
Q
EOJ ; EOJ Clean up and xit.
K AUPNLK("INAC")
K APCDX,APCDBD,APCDBDD,APCDT,APCDED,APCDSD,APCDODAT,APCDVDFN,APCDLST,APCDHRN,APCDVR,APCDCAT,APCDTYPE,%,%1,APCDEDD,IO("Q"),APCDF
Q
;
BROWSE ;
D VIEWR^XBLM("DRIVER^APCDVLST","Visit List in Date Range")
Q
DISP ;
S APCDHRN="" S:$D(^AUPNPAT(AUPNPAT,41,DUZ(2),0)) APCDHRN=$P(^AUPNPAT(AUPNPAT,41,DUZ(2),0),U,2)
W:APCDF !!,"Visits for ",$P(^DPT(AUPNPAT,0),U)," in ",$S(APCDX="P":"Posting",APCDX="V":"Visit",1:"Posting")," date range ",APCDBDD," to ",APCDEDD,!,"Health Record Number: ",APCDHRN,!
S APCDF=0
S DA=APCDVDFN,DIC="^AUPNVSIT(",DR="0:VCN" D EN^DIQ
NEW POV S POV=0 F S POV=$O(^AUPNVPOV("AD",APCDVDFN,POV)) Q:POV'=+POV W ?5,$$GET1^DIQ(9000010.07,POV,.01),?15,$$GET1^DIQ(9000010.07,POV,.04),!
Q
;
P ; Run by Posting date
S APCDODAT=$O(^AUPNVSIT("AMRG",APCDSD)) Q:APCDODAT=""
S APCDVDFN=$O(^AUPNVSIT("AMRG",APCDODAT,"")) I APCDVDFN="" W !,"An error has occurred in the AMRG cross reference. Please notify your Supervisor" Q
S APCDVDFN=APCDVDFN-1
F APCDL=0:0 S APCDVDFN=$O(^AUPNVSIT("AC",AUPNPAT,APCDVDFN)) Q:APCDVDFN'=+APCDVDFN S:$D(^AUPNVSIT(APCDVDFN,0)) APCDODAT=$P(^AUPNVSIT(APCDVDFN,0),U,2) Q:(APCDODAT>APCDED) I $D(^AUPNVSIT(APCDVDFN,0)),'$P(^(0),U,11) D DISP
Q
V ; Run by visit date
S APCDODAT=9999999-(APCDED+1),APCDLST=(9999999-APCDBD)_".9999"
F S APCDODAT=$O(^AUPNVSIT("AA",AUPNPAT,APCDODAT)) Q:APCDODAT="" Q:APCDODAT>APCDLST D V1
Q
V1 ;
S APCDVDFN=0 F S APCDVDFN=$O(^AUPNVSIT("AA",AUPNPAT,APCDODAT,APCDVDFN)) Q:APCDVDFN'=+APCDVDFN I '$P(^AUPNVSIT(APCDVDFN,0),U,11) D DISP
Q
ERR W !,"Must be a valid date and be Today or earlier. Time not allowed!" Q
Q
APCDVLST ; IHS/CMI/LAB - VISIT LIST BY PATIENT ;
+1 ;;2.0;IHS PCC SUITE;**11**;MAY 14, 2009;Build 58
+2 IF $DATA(IOF)
WRITE @IOF
WRITE !,"This routine will list all Visits for a Selected Patient in a",!,"specified Posting Date or Visit Date Range.",!
+3 ;
RDPV ; Determine to run by Posting date or Visit date
+1 SET APCDBEEP=$CHAR(7)_$CHAR(7)
SET APCDSITE=""
IF $DATA(DUZ(2))
SET APCDSITE=DUZ(2)
+2 IF '$DATA(DUZ(2))
SET APCDSITE=+^AUTTSITE(1,0)
+3 SET DIR(0)="S^1:Posting Date;2:Visit Date"
SET DIR("A")="Run Report by"
SET DIR("B")="P"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+4 IF $DATA(DIRUT)
GOTO EOJ
+5 SET Y=$EXTRACT(Y)
SET APCDX=$SELECT(Y=1:"P",Y=2:"V",1:Y)
GETDATES ;
BD ;get beginning date
+1 WRITE !
SET DIR(0)="D^:DT:EP"
SET DIR("A")="Enter beginning "_$SELECT(APCDX="P":"Posting",APCDX="V":"Visit",1:"Posting")_" Date for Search"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 SET APCDBD=Y
+3 IF $DATA(DIRUT)
GOTO EOJ
+4 SET APCDBD=Y
DO DD^%DT
SET APCDBDD=Y
ED ;get ending date
+1 WRITE !
SET DIR(0)="DA^"_APCDBD_":DT:EP"
SET DIR("A")="Enter ending "_$SELECT(APCDX="P":"Posting",APCDX="V":"Visit",1:"Posting")_" Date for Search: "
SET Y=APCDBD
DO DD^%DT
SET DIR("B")=Y
SET Y=""
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
GOTO BD
+3 SET APCDED=Y
DO DD^%DT
SET APCDEDD=Y
+4 SET X1=APCDBD
SET X2=-1
DO C^%DTC
SET APCDSD=X
+5 ;
GETPAT ; GET PATIENT
+1 KILL AUPNDOB,AUPNDOD,AUPNSEX
+2 WRITE !
+3 SET AUPNLK("INAC")=""
+4 SET AUPNPAT=""
+5 SET DIC="^AUPNPAT("
SET DIC(0)="AEMQ"
DO ^DIC
KILL DIC
+6 IF Y<0
GOTO EOJ
+7 SET AUPNPAT=+Y
BRPR ;
+1 SET DIR(0)="SO^B:BROWSE Output on Screen;P:PRINT Output to Printer"
SET DIR("A")="Do you want to"
SET DIR("B")="B"
KILL DA
DO ^DIR
KILL DIR
+2 IF $DATA(DIRUT)
GOTO GETPAT
+3 IF Y="B"
DO BROWSE
DO EOJ
QUIT
+4 SET XBRP="DRIVER^APCDVLST"
SET XBRC="PROC^APCDVLST"
SET XBRX="EOJ^APCDVLST"
SET XBNS="APCD;AUPN"
+5 DO ^XBDBQUE
+6 DO EOJ
+7 QUIT
+8 ;
DRIVER ; Driver
+1 SET APCDF=1
+2 DO @APCDX
+3 QUIT
+4 ;
PROC ;EP - called from xbdbque
+1 QUIT
EOJ ; EOJ Clean up and xit.
+1 KILL AUPNLK("INAC")
+2 KILL APCDX,APCDBD,APCDBDD,APCDT,APCDED,APCDSD,APCDODAT,APCDVDFN,APCDLST,APCDHRN,APCDVR,APCDCAT,APCDTYPE,%,%1,APCDEDD,IO("Q"),APCDF
+3 QUIT
+4 ;
BROWSE ;
+1 DO VIEWR^XBLM("DRIVER^APCDVLST","Visit List in Date Range")
+2 QUIT
DISP ;
+1 SET APCDHRN=""
IF $DATA(^AUPNPAT(AUPNPAT,41,DUZ(2),0))
SET APCDHRN=$PIECE(^AUPNPAT(AUPNPAT,41,DUZ(2),0),U,2)
+2 IF APCDF
WRITE !!,"Visits for ",$PIECE(^DPT(AUPNPAT,0),U)," in ",$SELECT(APCDX="P":"Posting",APCDX="V":"Visit",1:"Posting")," date range ",APCDBDD," to ",APCDEDD,!,"Health Record Number: ",APCDHRN,!
+3 SET APCDF=0
+4 SET DA=APCDVDFN
SET DIC="^AUPNVSIT("
SET DR="0:VCN"
DO EN^DIQ
+5 NEW POV
SET POV=0
FOR
SET POV=$ORDER(^AUPNVPOV("AD",APCDVDFN,POV))
IF POV'=+POV
QUIT
WRITE ?5,$$GET1^DIQ(9000010.07,POV,.01),?15,$$GET1^DIQ(9000010.07,POV,.04),!
+6 QUIT
+7 ;
P ; Run by Posting date
+1 SET APCDODAT=$ORDER(^AUPNVSIT("AMRG",APCDSD))
IF APCDODAT=""
QUIT
+2 SET APCDVDFN=$ORDER(^AUPNVSIT("AMRG",APCDODAT,""))
IF APCDVDFN=""
WRITE !,"An error has occurred in the AMRG cross reference. Please notify your Supervisor"
QUIT
+3 SET APCDVDFN=APCDVDFN-1
+4 FOR APCDL=0:0
SET APCDVDFN=$ORDER(^AUPNVSIT("AC",AUPNPAT,APCDVDFN))
IF APCDVDFN'=+APCDVDFN
QUIT
IF $DATA(^AUPNVSIT(APCDVDFN,0))
SET APCDODAT=$PIECE(^AUPNVSIT(APCDVDFN,0),U,2)
IF (APCDODAT>APCDED)
QUIT
IF $DATA(^AUPNVSIT(APCDVDFN,0))
IF '$PIECE(^(0),U,11)
DO DISP
+5 QUIT
V ; Run by visit date
+1 SET APCDODAT=9999999-(APCDED+1)
SET APCDLST=(9999999-APCDBD)_".9999"
+2 FOR
SET APCDODAT=$ORDER(^AUPNVSIT("AA",AUPNPAT,APCDODAT))
IF APCDODAT=""
QUIT
IF APCDODAT>APCDLST
QUIT
DO V1
+3 QUIT
V1 ;
+1 SET APCDVDFN=0
FOR
SET APCDVDFN=$ORDER(^AUPNVSIT("AA",AUPNPAT,APCDODAT,APCDVDFN))
IF APCDVDFN'=+APCDVDFN
QUIT
IF '$PIECE(^AUPNVSIT(APCDVDFN,0),U,11)
DO DISP
+2 QUIT
ERR WRITE !,"Must be a valid date and be Today or earlier. Time not allowed!"
QUIT
+1 QUIT
