- 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
