AMHRE1 ; IHS/CMI/LAB - ;
;;4.0;IHS BEHAVIORAL HEALTH;**4**;JUN 18, 2010;Build 28
;
START ;
D XIT
I '$D(IOF) D HOME^%ZIS
W @(IOF),!!
K AMHQ
I '$G(DUZ(2)) W $C(7),$C(7),!!,"SITE NOT SET IN DUZ(2) - NOTIFY SITE MANAGER!!",!! Q
D INFORM
TYPE ; type of problem code
S AMHPTYPE=""
S DIR(0)="S^P:Problem Code and all diagnosis codes grouped under it;D:Individual Problem or diagnosis codes",DIR("A")="Which Type",DIR("B")="P" KILL DA D ^DIR KILL DIR
I $D(DIRUT) D XIT Q
S AMHPTYPE=Y
I AMHPTYPE="P" G PROBCODE
PROBLIST ;get problem list
K AMHPROB S AMHC=0
PROB1 ;
W ! K DIC S DIC="^AMHPROB(",DIC(0)="AEMQ",DIC("A")="Enter "_$S(AMHC=0:"",1:"Another ")_"Problem/Diagnosis Code: " D ^DIC
I Y=-1,'$D(AMHPROB) W !!,"No problems selected. Exiting." D XIT Q
I Y=-1,$O(AMHPROB(0)) G GETDATES
I X="",$O(AMHPROB(0)) G GETDATES
S AMHC=AMHC+1,AMHPROB(+Y)=""
G PROB1
PROBCODE ;
K AMHPROB S AMHC=0
PROB2 ;
W ! K DIC S DIC="^AMHPROBC(",DIC(0)="AEMQ",DIC("A")="Enter "_$S(AMHC=0:"",1:"Another ")_"Problem Code: " D ^DIC
I Y=-1,'$D(AMHPROB) W !!,"No problems selected. Exiting." D XIT Q
I Y=-1,$O(AMHPROB(0)) G GETDATES
I X="",$O(AMHPROB(0)) G GETDATES
W !!,"The following Problem/Diagnosis codes will be included: "
S X=0 F S X=$O(^AMHPROB("AC",+Y,X)) Q:X'=+X S AMHPROB(X)="" W " ",$P(^AMHPROB(X,0),U) S AMHC=AMHC+1
G PROB2
GETDATES ;
W:$D(IOF) @IOF W !,"You have selected the following Problem/Diagnosis Codes"
S X=0 F S X=$O(AMHPROB(X)) Q:X'=+X W !?5,$P(^AMHPROB(X,0),U),?13,$P(^AMHPROB(X,0),U,2)
BD ;get beginning date
W !!!,"Please enter the date range during which the patient should have been seen ",!,"with one of these problems.",!
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 XIT
S AMHBD=Y
ED ;get ending date
W ! S DIR(0)="D^"_AMHBD_":DT:EP",DIR("A")="Enter Ending Visit 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 AMHSD=$$FMADD^XLFDT(AMHBD,-1)_".9999"
;
DEMO ;
D DEMOCHK^AMHUTIL1(.AMHDEMO)
I AMHDEMO=-1 G GETDATES
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^AMHRE1",XBRP="PRINT^AMHRE1",XBNS="AMH",XBRX="XIT^AMHRE1"
D ^XBDBQUE
XIT ;
D EN^XBVK("AMH"),^XBFMK
Q
;
BROWSE ;
S XBRP="VIEWR^XBLM(""PRINT^AMHRE1"")"
S XBNS="AMH",XBRC="PROC^AMHRE1",XBRX="XIT^AMHRE1",XBIOP=0 D ^XBDBQUE
Q
;
PROC ;EP - called from xbdbque
S AMHBT=$H
S ^XTMP("AMHRE1",0)=$$FMADD^XLFDT(DT,14)_"^"_DT_"^"_"BH PROBLEM REPORT"
S AMHJ=$J,AMHH=$H,AMHCNT=0
K ^XTMP("AMHRE1",AMHJ,AMHH)
;$O through all visits and set for patient once
F S AMHSD=$O(^AMHREC("B",AMHSD)) Q:AMHSD=""!((AMHSD\1)>AMHED) D
.S (AMHR,AMHRCNT)=0 F S AMHR=$O(^AMHREC("B",AMHSD,AMHR)) Q:AMHR'=+AMHR I $D(^AMHREC(AMHR,0)),$P(^(0),U,2)]"",$P(^(0),U,3)]"" S AMHR0=^(0) D PROC1
S AMHET=$H
Q
PROC1 ;
Q:'$$ALLOWVI^AMHUTIL(DUZ,AMHR)
S DFN=$P(AMHR0,U,8) Q:DFN="" ;do not use if no patient
Q:'$$ALLOWP^AMHUTIL(DUZ,DFN)
Q:$$DEMO^AMHUTIL1(DFN,$G(AMHDEMO))
Q:'$D(^AMHRPRO("AD",AMHR)) ;quit if no problems entered
;find pov
S (AMHFOUND,X)=0,AMHSORT="" F S X=$O(^AMHRPRO("AD",AMHR,X)) Q:X'=+X!(AMHFOUND) S P=$P(^AMHRPRO(X,0),U) I $D(AMHPROB(P)) D
.Q:$D(^XTMP("AMHRE1",AMHJ,AMHH,$P(^DPT(DFN,0),U),DFN,P)) ;already got this pov
.S ^XTMP("AMHRE1",AMHJ,AMHH,$P(^DPT(DFN,0),U),DFN,P)=AMHR
.Q
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 !!,"This report will list all patients who have been seen for a diagnosis/problem",!,"selected by the user in the date range selected by the user. For example,"
W !,"you may enter all suicide problem codes (39, 40, 41) and you will get a list",!,"of all patients seen for suicide and can then use this report",!,"to assist in follow up activities.",!
W !!,"The report will list Designated Provider, Patient Name, date seen for",!,"this problem, and date last seen.",!!
D DBHUSRP^AMHUTIL,DBHUSR^AMHUTIL,PAUSE^AMHLEA
Q
PRINT ;EP - called from xbdbque
S AMHPG=0 D HEADER
I '$D(^XTMP("AMHRE1",AMHJ,AMHH)) W !!,"NO PATIENTS TO REPORT" G DONE
S DFN="" K AMHQ
S AMHNAME="" F S AMHNAME=$O(^XTMP("AMHRE1",AMHJ,AMHH,AMHNAME)) Q:AMHNAME=""!($D(AMHQ)) D
.S DFN=0 F S DFN=$O(^XTMP("AMHRE1",AMHJ,AMHH,AMHNAME,DFN)) Q:DFN'=+DFN!($D(AMHQ)) D
..I $Y>(IOSL-4) D HEADER Q:$D(AMHQ)
..W !,$E(AMHNAME,1,25),?27,$$HRN^AUPNPAT(DFN,DUZ(2)),?34,$$D($$DOB^AUPNPAT(DFN)),?44,$P(^DPT(DFN,0),U,2) D
...S AMHP=0,AMHC=0 F S AMHP=$O(^XTMP("AMHRE1",AMHJ,AMHH,AMHNAME,DFN,AMHP)) Q:AMHP'=+AMHP!($D(AMHQ)) D
....S AMHR=^XTMP("AMHRE1",AMHJ,AMHH,AMHNAME,DFN,AMHP)
....S AMHC=AMHC+1 I AMHC=1 W ?47,$$PPINI^AMHUTIL(AMHR),?52,$P(^AMHPROB(AMHP,0),U),?62,$$D($P(^AMHREC(AMHR,0),U)),?72,$$D($$LVD^AMHDPEE(DFN,"ID")) Q
....I $Y>(IOSL-4) D HEADER Q:$D(AMHQ)
....W !?52,$P(^AMHPROB(AMHP,0),U),?62,$$D($P(^AMHREC(AMHR,0),U))
....Q
...Q
..I $Y>(IOSL-4) D HEADER Q:$D(AMHQ)
..I $P($G(^AMHPATR(DFN,0)),U,2)]"" W !?3,"Designated MH Prov: ",$E($$VAL^XBDIQ1(9002011.55,DFN,.02),1,20)
..S AMHS=0 I $P($G(^AMHPATR(DFN,0)),U,3) W !?3,"Designated SS Prov: ",$E($$VAL^XBDIQ1(9002011.55,DFN,.03),1,20) S AMHS=1
..I $P($G(^AMHPATR(DFN,0)),U,4) W ?$S(AMHS:42,1:3),"Desginated CD Prov: ",$E($$VAL^XBDIQ1(9002011.55,DFN,.04),1,20)
..Q
.Q
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 AMHTS,AMHS,AMHM,AMHET
K ^XTMP("AMHRE1",AMHJ,AMHH),AMHJ,AMHH
Q
;
G:'AMHPG 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 AMHQ="" Q
W:$D(IOF) @IOF S AMHPG=AMHPG+1
W !?3,$P(^VA(200,DUZ,0),U,2),?35,$$FMTE^XLFDT(DT),?70,"Page ",AMHPG,!
W !,$$CTR("PATIENTS SEEN WITH SELECTED DIAGNOSES/PROBLEMS",80),!
S X="Visit Dates: "_$$FMTE^XLFDT(AMHBD)_" to "_$$FMTE^XLFDT(AMHED) W $$CTR(X,80),!
W !,"PATIENT NAME",?27,"HRN",?34,"DOB",?43,"SEX",?47,"PROV",?52,"DX",?62,"DATE SEEN",?72,"LAST VIS"
W !,$TR($J("",80)," ","-")
Q
AMHRE1 ; IHS/CMI/LAB - ;
+1 ;;4.0;IHS BEHAVIORAL HEALTH;**4**;JUN 18, 2010;Build 28
+2 ;
START ;
+1 DO XIT
+2 IF '$DATA(IOF)
DO HOME^%ZIS
+3 WRITE @(IOF),!!
+4 KILL AMHQ
+5 IF '$GET(DUZ(2))
WRITE $CHAR(7),$CHAR(7),!!,"SITE NOT SET IN DUZ(2) - NOTIFY SITE MANAGER!!",!!
QUIT
+6 DO INFORM
TYPE ; type of problem code
+1 SET AMHPTYPE=""
+2 SET DIR(0)="S^P:Problem Code and all diagnosis codes grouped under it;D:Individual Problem or diagnosis codes"
SET DIR("A")="Which Type"
SET DIR("B")="P"
KILL DA
DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)
DO XIT
QUIT
+4 SET AMHPTYPE=Y
+5 IF AMHPTYPE="P"
GOTO PROBCODE
PROBLIST ;get problem list
+1 KILL AMHPROB
SET AMHC=0
PROB1 ;
+1 WRITE !
KILL DIC
SET DIC="^AMHPROB("
SET DIC(0)="AEMQ"
SET DIC("A")="Enter "_$SELECT(AMHC=0:"",1:"Another ")_"Problem/Diagnosis Code: "
DO ^DIC
+2 IF Y=-1
IF '$DATA(AMHPROB)
WRITE !!,"No problems selected. Exiting."
DO XIT
QUIT
+3 IF Y=-1
IF $ORDER(AMHPROB(0))
GOTO GETDATES
+4 IF X=""
IF $ORDER(AMHPROB(0))
GOTO GETDATES
+5 SET AMHC=AMHC+1
SET AMHPROB(+Y)=""
+6 GOTO PROB1
PROBCODE ;
+1 KILL AMHPROB
SET AMHC=0
PROB2 ;
+1 WRITE !
KILL DIC
SET DIC="^AMHPROBC("
SET DIC(0)="AEMQ"
SET DIC("A")="Enter "_$SELECT(AMHC=0:"",1:"Another ")_"Problem Code: "
DO ^DIC
+2 IF Y=-1
IF '$DATA(AMHPROB)
WRITE !!,"No problems selected. Exiting."
DO XIT
QUIT
+3 IF Y=-1
IF $ORDER(AMHPROB(0))
GOTO GETDATES
+4 IF X=""
IF $ORDER(AMHPROB(0))
GOTO GETDATES
+5 WRITE !!,"The following Problem/Diagnosis codes will be included: "
+6 SET X=0
FOR
SET X=$ORDER(^AMHPROB("AC",+Y,X))
IF X'=+X
QUIT
SET AMHPROB(X)=""
WRITE " ",$PIECE(^AMHPROB(X,0),U)
SET AMHC=AMHC+1
+7 GOTO PROB2
GETDATES ;
+1 IF $DATA(IOF)
WRITE @IOF
WRITE !,"You have selected the following Problem/Diagnosis Codes"
+2 SET X=0
FOR
SET X=$ORDER(AMHPROB(X))
IF X'=+X
QUIT
WRITE !?5,$PIECE(^AMHPROB(X,0),U),?13,$PIECE(^AMHPROB(X,0),U,2)
BD ;get beginning date
+1 WRITE !!!,"Please enter the date range during which the patient should have been seen ",!,"with one of these problems.",!
+2 SET DIR(0)="D^:DT:EP"
SET DIR("A")="Enter Beginning Visit 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 Visit 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 AMHSD=$$FMADD^XLFDT(AMHBD,-1)_".9999"
+5 ;
DEMO ;
+1 DO DEMOCHK^AMHUTIL1(.AMHDEMO)
+2 IF AMHDEMO=-1
GOTO GETDATES
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^AMHRE1"
SET XBRP="PRINT^AMHRE1"
SET XBNS="AMH"
SET XBRX="XIT^AMHRE1"
+5 DO ^XBDBQUE
XIT ;
+1 DO EN^XBVK("AMH")
DO ^XBFMK
+2 QUIT
+3 ;
BROWSE ;
+1 SET XBRP="VIEWR^XBLM(""PRINT^AMHRE1"")"
+2 SET XBNS="AMH"
SET XBRC="PROC^AMHRE1"
SET XBRX="XIT^AMHRE1"
SET XBIOP=0
DO ^XBDBQUE
+3 QUIT
+4 ;
PROC ;EP - called from xbdbque
+1 SET AMHBT=$HOROLOG
+2 SET ^XTMP("AMHRE1",0)=$$FMADD^XLFDT(DT,14)_"^"_DT_"^"_"BH PROBLEM REPORT"
+3 SET AMHJ=$JOB
SET AMHH=$HOROLOG
SET AMHCNT=0
+4 KILL ^XTMP("AMHRE1",AMHJ,AMHH)
+5 ;$O through all visits and set for patient once
+6 FOR
SET AMHSD=$ORDER(^AMHREC("B",AMHSD))
IF AMHSD=""!((AMHSD\1)>AMHED)
QUIT
Begin DoDot:1
+7 SET (AMHR,AMHRCNT)=0
FOR
SET AMHR=$ORDER(^AMHREC("B",AMHSD,AMHR))
IF AMHR'=+AMHR
QUIT
IF $DATA(^AMHREC(AMHR,0))
IF $PIECE(^(0),U,2)]""
IF $PIECE(^(0),U,3)]""
SET AMHR0=^(0)
DO PROC1
End DoDot:1
+8 SET AMHET=$HOROLOG
+9 QUIT
PROC1 ;
+1 IF '$$ALLOWVI^AMHUTIL(DUZ,AMHR)
QUIT
+2 ;do not use if no patient
SET DFN=$PIECE(AMHR0,U,8)
IF DFN=""
QUIT
+3 IF '$$ALLOWP^AMHUTIL(DUZ,DFN)
QUIT
+4 IF $$DEMO^AMHUTIL1(DFN,$GET(AMHDEMO))
QUIT
+5 ;quit if no problems entered
IF '$DATA(^AMHRPRO("AD",AMHR))
QUIT
+6 ;find pov
+7 SET (AMHFOUND,X)=0
SET AMHSORT=""
FOR
SET X=$ORDER(^AMHRPRO("AD",AMHR,X))
IF X'=+X!(AMHFOUND)
QUIT
SET P=$PIECE(^AMHRPRO(X,0),U)
IF $DATA(AMHPROB(P))
Begin DoDot:1
+8 ;already got this pov
IF $DATA(^XTMP("AMHRE1",AMHJ,AMHH,$PIECE(^DPT(DFN,0),U),DFN,P))
QUIT
+9 SET ^XTMP("AMHRE1",AMHJ,AMHH,$PIECE(^DPT(DFN,0),U),DFN,P)=AMHR
+10 QUIT
End DoDot:1
+11 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 !!,"This report will list all patients who have been seen for a diagnosis/problem",!,"selected by the user in the date range selected by the user. For example,"
+2 WRITE !,"you may enter all suicide problem codes (39, 40, 41) and you will get a list",!,"of all patients seen for suicide and can then use this report",!,"to assist in follow up activities.",!
+3 WRITE !!,"The report will list Designated Provider, Patient Name, date seen for",!,"this problem, and date last seen.",!!
+4 DO DBHUSRP^AMHUTIL
DO DBHUSR^AMHUTIL
DO PAUSE^AMHLEA
+5 QUIT
PRINT ;EP - called from xbdbque
+1 SET AMHPG=0
DO HEADER
+2 IF '$DATA(^XTMP("AMHRE1",AMHJ,AMHH))
WRITE !!,"NO PATIENTS TO REPORT"
GOTO DONE
+3 SET DFN=""
KILL AMHQ
+4 SET AMHNAME=""
FOR
SET AMHNAME=$ORDER(^XTMP("AMHRE1",AMHJ,AMHH,AMHNAME))
IF AMHNAME=""!($DATA(AMHQ))
QUIT
Begin DoDot:1
+5 SET DFN=0
FOR
SET DFN=$ORDER(^XTMP("AMHRE1",AMHJ,AMHH,AMHNAME,DFN))
IF DFN'=+DFN!($DATA(AMHQ))
QUIT
Begin DoDot:2
+6 IF $Y>(IOSL-4)
DO HEADER
IF $DATA(AMHQ)
QUIT
+7 WRITE !,$EXTRACT(AMHNAME,1,25),?27,$$HRN^AUPNPAT(DFN,DUZ(2)),?34,$$D($$DOB^AUPNPAT(DFN)),?44,$PIECE(^DPT(DFN,0),U,2)
Begin DoDot:3
+8 SET AMHP=0
SET AMHC=0
FOR
SET AMHP=$ORDER(^XTMP("AMHRE1",AMHJ,AMHH,AMHNAME,DFN,AMHP))
IF AMHP'=+AMHP!($DATA(AMHQ))
QUIT
Begin DoDot:4
+9 SET AMHR=^XTMP("AMHRE1",AMHJ,AMHH,AMHNAME,DFN,AMHP)
+10 SET AMHC=AMHC+1
IF AMHC=1
WRITE ?47,$$PPINI^AMHUTIL(AMHR),?52,$PIECE(^AMHPROB(AMHP,0),U),?62,$$D($PIECE(^AMHREC(AMHR,0),U)),?72,$$D($$LVD^AMHDPEE(DFN,"ID"))
QUIT
+11 IF $Y>(IOSL-4)
DO HEADER
IF $DATA(AMHQ)
QUIT
+12 WRITE !?52,$PIECE(^AMHPROB(AMHP,0),U),?62,$$D($PIECE(^AMHREC(AMHR,0),U))
+13 QUIT
End DoDot:4
+14 QUIT
End DoDot:3
+15 IF $Y>(IOSL-4)
DO HEADER
IF $DATA(AMHQ)
QUIT
+16 IF $PIECE($GET(^AMHPATR(DFN,0)),U,2)]""
WRITE !?3,"Designated MH Prov: ",$EXTRACT($$VAL^XBDIQ1(9002011.55,DFN,.02),1,20)
+17 SET AMHS=0
IF $PIECE($GET(^AMHPATR(DFN,0)),U,3)
WRITE !?3,"Designated SS Prov: ",$EXTRACT($$VAL^XBDIQ1(9002011.55,DFN,.03),1,20)
SET AMHS=1
+18 IF $PIECE($GET(^AMHPATR(DFN,0)),U,4)
WRITE ?$SELECT(AMHS:42,1:3),"Desginated CD Prov: ",$EXTRACT($$VAL^XBDIQ1(9002011.55,DFN,.04),1,20)
+19 QUIT
End DoDot:2
+20 QUIT
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 AMHTS,AMHS,AMHM,AMHET
+4 KILL ^XTMP("AMHRE1",AMHJ,AMHH),AMHJ,AMHH
+5 QUIT
+6 ;
+1 IF 'AMHPG
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 AMHQ=""
QUIT
+1 IF $DATA(IOF)
WRITE @IOF
SET AMHPG=AMHPG+1
+2 WRITE !?3,$PIECE(^VA(200,DUZ,0),U,2),?35,$$FMTE^XLFDT(DT),?70,"Page ",AMHPG,!
+3 WRITE !,$$CTR("PATIENTS SEEN WITH SELECTED DIAGNOSES/PROBLEMS",80),!
+4 SET X="Visit Dates: "_$$FMTE^XLFDT(AMHBD)_" to "_$$FMTE^XLFDT(AMHED)
WRITE $$CTR(X,80),!
+5 WRITE !,"PATIENT NAME",?27,"HRN",?34,"DOB",?43,"SEX",?47,"PROV",?52,"DX",?62,"DATE SEEN",?72,"LAST VIS"
+6 WRITE !,$TRANSLATE($JUSTIFY("",80)," ","-")
+7 QUIT
