- AMHRC3 ; IHS/CMI/LAB - TIME IN GRP REPORT ;
- ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
- ;
- START ;
- I '$D(IOF) D HOME^%ZIS
- W @(IOF),!!
- W "********** LISTING OF PATIENTS WHO HAVE SPENT TIME IN GROUP **********",!!
- W "This report will produce a list of patients who have spent time in a group.",!,"It will list the patient, the primary provider, diagnoses and time",!,"spent in the group for a date range you enter.",!!
- D DBHUSR^AMHUTIL
- GETDATES ;
- BD ;get beginning date
- W !,"Please enter the date range during which the patient should be seen",!,"in a group.",!
- W ! S DIR(0)="D^:DT:EP",DIR("A")="Enter beginning Date" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
- I $D(DIRUT) G XIT
- S AMHBD=Y
- ED ;get ending date
- W ! S DIR(0)="D^"_AMHBD_":DT:EP",DIR("A")="Enter ending Date" S Y=AMHBD D DD^%DT D ^DIR K DIR S:$D(DUOUT) DIRUT=1
- I $D(DIRUT) G BD
- S AMHED=Y
- S X1=AMHBD,X2=-1 D C^%DTC S AMHSD=X S Y=AMHBD D DD^%DT S AMHBDD=Y S Y=AMHED D DD^%DT S AMHEDD=Y
- ;
- DEMO ;
- D DEMOCHK^AMHUTIL1(.AMHDEMO)
- I AMHDEMO=-1 G BD
- ZIS ;
- 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^AMHRC3",XBRP="PRINT^AMHRC3",XBNS="AMH",XBRX="XIT^AMHRC3"
- D ^XBDBQUE
- XIT K ZTSK,Y,AMHBD,AMHED,IO("Q"),AMH80D,AMHBTH,AMHHRCN,AMHJOB,AMHLENG,AMHPCNT,AMHPG,AMHNUM,AMHX,DFN,DIC,DIR,DIRUT,DTOUT,DUOUT,XBNS,XBRC,XBRP,XBTX,D,AMHFOUN,AMHPOV,AMHRA,AMHRX,AMHRY
- K AMHPRNM,AMHPRNT,AMHPROB,AMHPRV,AMHR,AMHRCNT,AMHRLOC,AMHSD,AMHTOT,AMHBDD,AMHBT,AMHEDD,AMHEDO,AMHBDO,AMHBT,AMHFOUND,AMHHIT,AMHID,AMHLINE,AMHP
- Q
- BROWSE ;
- S XBRP="VIEWR^XBLM(""PRINT^AMHRC3"")"
- S XBNS="AMH",XBRC="PROC^AMHRC3",XBRX="XIT^AMHRC3",XBIOP=0 D ^XBDBQUE
- Q
- ;
- PROC ;EP - entry point for processing
- S AMHJOB=$J,AMHBTH=$H,AMHTOT=0,DFN=0,AMHBT=$H
- D XTMP^AMHUTIL("AMHRC3","BH - PTS WITH GROUP VISITS")
- S AMHSD=AMHSD_".9999"
- F S AMHSD=$O(^AMHREC("B",AMHSD)) Q:AMHSD'=+AMHSD!($P(AMHSD,".")>AMHED) D PROC1
- S AMHET=$H
- K DFN
- Q
- PROC1 ;
- S AMHR=0 F S AMHR=$O(^AMHREC("B",AMHSD,AMHR)) Q:AMHR'=+AMHR D
- .Q:'$$ALLOWVI^AMHUTIL(DUZ,AMHR)
- .Q:$P($G(^AMHREC(AMHR,11)),U,4)=""
- .Q:$P(^AMHREC(AMHR,0),U,8)=""
- .S DFN=$P(^AMHREC(AMHR,0),U,8)
- .Q:'$$ALLOWP^AMHUTIL(DUZ,DFN)
- .Q:$$DEMO^AMHUTIL1(DFN,$G(AMHDEMO))
- .S AMHPROV=$$PPINT^AMHUTIL(AMHR) I AMHPROV="" S AMHPROV="Not Recorded"
- .S AMHDX=$O(^AMHRPRO("AD",AMHR,0)) Q:AMHDX=""
- .S AMHDX=$P(^AMHRPRO(AMHDX,0),U)
- .S AMHTSG=$P($G(^AMHREC(AMHR,11)),U,4)
- .S ^XTMP("AMHRC3",AMHJOB,AMHBTH,"INDS",$P(^DPT(DFN,0),U),DFN,$P(AMHSD,"."),AMHR,AMHPROV,AMHDX)=AMHTSG
- .S ^XTMP("AMHRC3",AMHJOB,AMHBTH,"PROV",DFN,AMHPROV)=$G(^XTMP("AMHRC3",AMHJOB,AMHBTH,"PROV",DFN,AMHPROV))+AMHTSG
- .S ^XTMP("AMHRC3",AMHJOB,AMHBTH,"TOTAL",DFN)=$G(^XTMP("AMHRC3",AMHJOB,AMHBTH,"TOTAL",DFN))+AMHTSG
- Q
- ;
- PRINT ;
- S AMH80D="-------------------------------------------------------------------------------"
- S Y=AMHBD D DD^%DT S AMHBDD=Y S Y=AMHED D DD^%DT S AMHEDD=Y
- S AMHPG=0 D HEAD
- I '$D(^XTMP("AMHRC3",AMHJOB,AMHBTH)) W !!,"NO PATIENTS TO REPORT" G DONE
- S DFN="" K AMHQ
- S AMHNAME="" F S AMHNAME=$O(^XTMP("AMHRC3",AMHJOB,AMHBTH,"INDS",AMHNAME)) Q:AMHNAME=""!($D(AMHQ)) D
- .S DFN=0 F S DFN=$O(^XTMP("AMHRC3",AMHJOB,AMHBTH,"INDS",AMHNAME,DFN)) Q:DFN=""!($D(AMHQ)) D DFN
- G:$D(AMHQ) DONE
- DONE D DONE^AMHLEIN,^AMHEKL
- K ^XTMP("AMHRC3",AMHJOB,AMHBTH),AMHJOB,AMHBTH
- Q
- DFN ;
- I $Y>(IOSL-4) D HEAD Q:$D(AMHQ)
- S AMHHRCN=$S($D(^AUPNPAT(DFN,41,DUZ(2),0)):$P(^(0),U,2),1:"<none>")
- W !!,$E($P(^DPT(DFN,0),U),1,15),?18,AMHHRCN
- W ?26,$P(^DPT(DFN,0),U,2) S Y=$P(^DPT(DFN,0),U,3) W ?30,$E(Y,4,5),"/",$E(Y,6,7),"/",$E(Y,2,3)
- VSTS ; process visits
- S AMHDATE=0,AMHRC=0 F S AMHDATE=$O(^XTMP("AMHRC3",AMHJOB,AMHBTH,"INDS",AMHNAME,DFN,AMHDATE)) Q:AMHDATE'=+AMHDATE!($D(AMHQ)) D
- .S AMHRC=AMHRC+1
- .I AMHRC>1 W !
- .W ?40,$E(AMHDATE,4,5),"/",$E(AMHDATE,6,7),"/",$E(AMHDATE,2,3)
- .S AMHC=0,AMHR=0 F S AMHR=$O(^XTMP("AMHRC3",AMHJOB,AMHBTH,"INDS",AMHNAME,DFN,AMHDATE,AMHR)) Q:AMHR'=+AMHR!($D(AMHQ)) D
- ..S AMHC=AMHC+1
- ..I AMHC>1 W !
- ..S AMHPROV=$O(^XTMP("AMHRC3",AMHJOB,AMHBTH,"INDS",AMHNAME,DFN,AMHDATE,AMHR,0))
- ..I AMHPROV W ?49,$E($P(^VA(200,AMHPROV,0),U),1,15)
- ..I 'AMHPROV W ?49,AMHPROV
- ..S AMHDX=$O(^XTMP("AMHRC3",AMHJOB,AMHBTH,"INDS",AMHNAME,DFN,AMHDATE,AMHR,AMHPROV,0))
- ..W ?65,$P(^AMHPROB(AMHDX,0),U,1)
- ..W ?74,^XTMP("AMHRC3",AMHJOB,AMHBTH,"INDS",AMHNAME,DFN,AMHDATE,AMHR,AMHPROV,AMHDX)
- Q:$D(AMHQ)
- S AMHPROV=0 F S AMHPROV=$O(^XTMP("AMHRC3",AMHJOB,AMHBTH,"PROV",DFN,AMHPROV)) Q:AMHPROV'=+AMHPROV!($D(AMHQ)) D
- .W !?10,"Total with provider ",$S(AMHPROV:$E($P(^VA(200,AMHPROV,0),U),1,20),1:AMHPROV),?50,^XTMP("AMHRC3",AMHJOB,AMHBTH,"PROV",DFN,AMHPROV)
- Q:$D(AMHQ)
- W !?10,"Total for patient ",$E($P(^DPT(DFN,0),U,1),1,20),?50,^XTMP("AMHRC3",AMHJOB,AMHBTH,"TOTAL",DFN)
- Q
- HEAD I 'AMHPG G HEAD1
- I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S AMHQ="" Q
- HEAD1 ;
- W:$D(IOF) @IOF S AMHPG=AMHPG+1
- W !?13,"********** CONFIDENTIAL PATIENT INFORMATION **********"
- W !,$P(^VA(200,DUZ,0),U,2),?72,"Page ",AMHPG,!
- W ?(80-$L($P(^DIC(4,DUZ(2),0),U))/2),$P(^DIC(4,DUZ(2),0),U),!
- W ?22,"PATIENTS SEEN IN GROUPS WITH TIME SPENT IN GROUP",!
- W ?20,"DATES: ",AMHBDD," TO ",AMHEDD,!
- PIH W !!,"PATIENT NAME",?18,"HRN",?25,"SEX",?30,"DOB",?40,"DATE",?49,"PROVIDER",?65,"PROBLEM",?74,"TIME",!,AMH80D
- Q
- AMHRC3 ; IHS/CMI/LAB - TIME IN GRP REPORT ;
- +1 ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
- +2 ;
- START ;
- +1 IF '$DATA(IOF)
- DO HOME^%ZIS
- +2 WRITE @(IOF),!!
- +3 WRITE "********** LISTING OF PATIENTS WHO HAVE SPENT TIME IN GROUP **********",!!
- +4 WRITE "This report will produce a list of patients who have spent time in a group.",!,"It will list the patient, the primary provider, diagnoses and time",!,"spent in the group for a date range you enter.",!!
- +5 DO DBHUSR^AMHUTIL
- GETDATES ;
- BD ;get beginning date
- +1 WRITE !,"Please enter the date range during which the patient should be seen",!,"in a group.",!
- +2 WRITE !
- SET DIR(0)="D^:DT:EP"
- SET DIR("A")="Enter beginning Date"
- DO ^DIR
- KILL DIR
- IF $DATA(DUOUT)
- SET DIRUT=1
- +3 IF $DATA(DIRUT)
- GOTO XIT
- +4 SET AMHBD=Y
- ED ;get ending date
- +1 WRITE !
- SET DIR(0)="D^"_AMHBD_":DT:EP"
- SET DIR("A")="Enter ending Date"
- SET Y=AMHBD
- DO DD^%DT
- DO ^DIR
- KILL DIR
- IF $DATA(DUOUT)
- SET DIRUT=1
- +2 IF $DATA(DIRUT)
- GOTO BD
- +3 SET AMHED=Y
- +4 SET X1=AMHBD
- SET X2=-1
- DO C^%DTC
- SET AMHSD=X
- SET Y=AMHBD
- DO DD^%DT
- SET AMHBDD=Y
- SET Y=AMHED
- DO DD^%DT
- SET AMHEDD=Y
- +5 ;
- DEMO ;
- +1 DO DEMOCHK^AMHUTIL1(.AMHDEMO)
- +2 IF AMHDEMO=-1
- GOTO BD
- ZIS ;
- +1 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
- +2 IF $DATA(DIRUT)
- GOTO XIT
- +3 IF $GET(Y)="B"
- DO BROWSE
- DO XIT
- QUIT
- +4 SET XBRC="PROC^AMHRC3"
- SET XBRP="PRINT^AMHRC3"
- SET XBNS="AMH"
- SET XBRX="XIT^AMHRC3"
- +5 DO ^XBDBQUE
- XIT KILL ZTSK,Y,AMHBD,AMHED,IO("Q"),AMH80D,AMHBTH,AMHHRCN,AMHJOB,AMHLENG,AMHPCNT,AMHPG,AMHNUM,AMHX,DFN,DIC,DIR,DIRUT,DTOUT,DUOUT,XBNS,XBRC,XBRP,XBTX,D,AMHFOUN,AMHPOV,AMHRA,AMHRX,AMHRY
- +1 KILL AMHPRNM,AMHPRNT,AMHPROB,AMHPRV,AMHR,AMHRCNT,AMHRLOC,AMHSD,AMHTOT,AMHBDD,AMHBT,AMHEDD,AMHEDO,AMHBDO,AMHBT,AMHFOUND,AMHHIT,AMHID,AMHLINE,AMHP
- +2 QUIT
- BROWSE ;
- +1 SET XBRP="VIEWR^XBLM(""PRINT^AMHRC3"")"
- +2 SET XBNS="AMH"
- SET XBRC="PROC^AMHRC3"
- SET XBRX="XIT^AMHRC3"
- SET XBIOP=0
- DO ^XBDBQUE
- +3 QUIT
- +4 ;
- PROC ;EP - entry point for processing
- +1 SET AMHJOB=$JOB
- SET AMHBTH=$HOROLOG
- SET AMHTOT=0
- SET DFN=0
- SET AMHBT=$HOROLOG
- +2 DO XTMP^AMHUTIL("AMHRC3","BH - PTS WITH GROUP VISITS")
- +3 SET AMHSD=AMHSD_".9999"
- +4 FOR
- SET AMHSD=$ORDER(^AMHREC("B",AMHSD))
- IF AMHSD'=+AMHSD!($PIECE(AMHSD,".")>AMHED)
- QUIT
- DO PROC1
- +5 SET AMHET=$HOROLOG
- +6 KILL DFN
- +7 QUIT
- PROC1 ;
- +1 SET AMHR=0
- FOR
- SET AMHR=$ORDER(^AMHREC("B",AMHSD,AMHR))
- IF AMHR'=+AMHR
- QUIT
- Begin DoDot:1
- +2 IF '$$ALLOWVI^AMHUTIL(DUZ,AMHR)
- QUIT
- +3 IF $PIECE($GET(^AMHREC(AMHR,11)),U,4)=""
- QUIT
- +4 IF $PIECE(^AMHREC(AMHR,0),U,8)=""
- QUIT
- +5 SET DFN=$PIECE(^AMHREC(AMHR,0),U,8)
- +6 IF '$$ALLOWP^AMHUTIL(DUZ,DFN)
- QUIT
- +7 IF $$DEMO^AMHUTIL1(DFN,$GET(AMHDEMO))
- QUIT
- +8 SET AMHPROV=$$PPINT^AMHUTIL(AMHR)
- IF AMHPROV=""
- SET AMHPROV="Not Recorded"
- +9 SET AMHDX=$ORDER(^AMHRPRO("AD",AMHR,0))
- IF AMHDX=""
- QUIT
- +10 SET AMHDX=$PIECE(^AMHRPRO(AMHDX,0),U)
- +11 SET AMHTSG=$PIECE($GET(^AMHREC(AMHR,11)),U,4)
- +12 SET ^XTMP("AMHRC3",AMHJOB,AMHBTH,"INDS",$PIECE(^DPT(DFN,0),U),DFN,$PIECE(AMHSD,"."),AMHR,AMHPROV,AMHDX)=AMHTSG
- +13 SET ^XTMP("AMHRC3",AMHJOB,AMHBTH,"PROV",DFN,AMHPROV)=$GET(^XTMP("AMHRC3",AMHJOB,AMHBTH,"PROV",DFN,AMHPROV))+AMHTSG
- +14 SET ^XTMP("AMHRC3",AMHJOB,AMHBTH,"TOTAL",DFN)=$GET(^XTMP("AMHRC3",AMHJOB,AMHBTH,"TOTAL",DFN))+AMHTSG
- End DoDot:1
- +15 QUIT
- +16 ;
- PRINT ;
- +1 SET AMH80D="-------------------------------------------------------------------------------"
- +2 SET Y=AMHBD
- DO DD^%DT
- SET AMHBDD=Y
- SET Y=AMHED
- DO DD^%DT
- SET AMHEDD=Y
- +3 SET AMHPG=0
- DO HEAD
- +4 IF '$DATA(^XTMP("AMHRC3",AMHJOB,AMHBTH))
- WRITE !!,"NO PATIENTS TO REPORT"
- GOTO DONE
- +5 SET DFN=""
- KILL AMHQ
- +6 SET AMHNAME=""
- FOR
- SET AMHNAME=$ORDER(^XTMP("AMHRC3",AMHJOB,AMHBTH,"INDS",AMHNAME))
- IF AMHNAME=""!($DATA(AMHQ))
- QUIT
- Begin DoDot:1
- +7 SET DFN=0
- FOR
- SET DFN=$ORDER(^XTMP("AMHRC3",AMHJOB,AMHBTH,"INDS",AMHNAME,DFN))
- IF DFN=""!($DATA(AMHQ))
- QUIT
- DO DFN
- End DoDot:1
- +8 IF $DATA(AMHQ)
- GOTO DONE
- DONE DO DONE^AMHLEIN
- DO ^AMHEKL
- +1 KILL ^XTMP("AMHRC3",AMHJOB,AMHBTH),AMHJOB,AMHBTH
- +2 QUIT
- DFN ;
- +1 IF $Y>(IOSL-4)
- DO HEAD
- IF $DATA(AMHQ)
- QUIT
- +2 SET AMHHRCN=$SELECT($DATA(^AUPNPAT(DFN,41,DUZ(2),0)):$PIECE(^(0),U,2),1:"<none>")
- +3 WRITE !!,$EXTRACT($PIECE(^DPT(DFN,0),U),1,15),?18,AMHHRCN
- +4 WRITE ?26,$PIECE(^DPT(DFN,0),U,2)
- SET Y=$PIECE(^DPT(DFN,0),U,3)
- WRITE ?30,$EXTRACT(Y,4,5),"/",$EXTRACT(Y,6,7),"/",$EXTRACT(Y,2,3)
- VSTS ; process visits
- +1 SET AMHDATE=0
- SET AMHRC=0
- FOR
- SET AMHDATE=$ORDER(^XTMP("AMHRC3",AMHJOB,AMHBTH,"INDS",AMHNAME,DFN,AMHDATE))
- IF AMHDATE'=+AMHDATE!($DATA(AMHQ))
- QUIT
- Begin DoDot:1
- +2 SET AMHRC=AMHRC+1
- +3 IF AMHRC>1
- WRITE !
- +4 WRITE ?40,$EXTRACT(AMHDATE,4,5),"/",$EXTRACT(AMHDATE,6,7),"/",$EXTRACT(AMHDATE,2,3)
- +5 SET AMHC=0
- SET AMHR=0
- FOR
- SET AMHR=$ORDER(^XTMP("AMHRC3",AMHJOB,AMHBTH,"INDS",AMHNAME,DFN,AMHDATE,AMHR))
- IF AMHR'=+AMHR!($DATA(AMHQ))
- QUIT
- Begin DoDot:2
- +6 SET AMHC=AMHC+1
- +7 IF AMHC>1
- WRITE !
- +8 SET AMHPROV=$ORDER(^XTMP("AMHRC3",AMHJOB,AMHBTH,"INDS",AMHNAME,DFN,AMHDATE,AMHR,0))
- +9 IF AMHPROV
- WRITE ?49,$EXTRACT($PIECE(^VA(200,AMHPROV,0),U),1,15)
- +10 IF 'AMHPROV
- WRITE ?49,AMHPROV
- +11 SET AMHDX=$ORDER(^XTMP("AMHRC3",AMHJOB,AMHBTH,"INDS",AMHNAME,DFN,AMHDATE,AMHR,AMHPROV,0))
- +12 WRITE ?65,$PIECE(^AMHPROB(AMHDX,0),U,1)
- +13 WRITE ?74,^XTMP("AMHRC3",AMHJOB,AMHBTH,"INDS",AMHNAME,DFN,AMHDATE,AMHR,AMHPROV,AMHDX)
- End DoDot:2
- End DoDot:1
- +14 IF $DATA(AMHQ)
- QUIT
- +15 SET AMHPROV=0
- FOR
- SET AMHPROV=$ORDER(^XTMP("AMHRC3",AMHJOB,AMHBTH,"PROV",DFN,AMHPROV))
- IF AMHPROV'=+AMHPROV!($DATA(AMHQ))
- QUIT
- Begin DoDot:1
- +16 WRITE !?10,"Total with provider ",$SELECT(AMHPROV:$EXTRACT($PIECE(^VA(200,AMHPROV,0),U),1,20),1:AMHPROV),?50,^XTMP("AMHRC3",AMHJOB,AMHBTH,"PROV",DFN,AMHPROV)
- End DoDot:1
- +17 IF $DATA(AMHQ)
- QUIT
- +18 WRITE !?10,"Total for patient ",$EXTRACT($PIECE(^DPT(DFN,0),U,1),1,20),?50,^XTMP("AMHRC3",AMHJOB,AMHBTH,"TOTAL",DFN)
- +19 QUIT
- HEAD IF 'AMHPG
- GOTO HEAD1
- +1 IF $EXTRACT(IOST)="C"
- IF IO=IO(0)
- WRITE !
- SET DIR(0)="EO"
- DO ^DIR
- KILL DIR
- IF Y=0!(Y="^")!($DATA(DTOUT))
- SET AMHQ=""
- QUIT
- HEAD1 ;
- +1 IF $DATA(IOF)
- WRITE @IOF
- SET AMHPG=AMHPG+1
- +2 WRITE !?13,"********** CONFIDENTIAL PATIENT INFORMATION **********"
- +3 WRITE !,$PIECE(^VA(200,DUZ,0),U,2),?72,"Page ",AMHPG,!
- +4 WRITE ?(80-$LENGTH($PIECE(^DIC(4,DUZ(2),0),U))/2),$PIECE(^DIC(4,DUZ(2),0),U),!
- +5 WRITE ?22,"PATIENTS SEEN IN GROUPS WITH TIME SPENT IN GROUP",!
- +6 WRITE ?20,"DATES: ",AMHBDD," TO ",AMHEDD,!
- PIH WRITE !!,"PATIENT NAME",?18,"HRN",?25,"SEX",?30,"DOB",?40,"DATE",?49,"PROVIDER",?65,"PROBLEM",?74,"TIME",!,AMH80D
- +1 QUIT
