AMHRLP ; IHS/CMI/LAB - TUCSON-OHPRD/LAB - PRINT BH RECORD REPORT ;
;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
START ;EP - Set up header line, dash line
K ^XTMP("AMHFLAT",$J) ;just in case
S X=0,AMHHEAD="" F S X=$O(^AMHTRPT(AMHRPT,12,X)) Q:X'=+X S AMHHDR=$P(^AMHSORT($P(^AMHTRPT(AMHRPT,12,X,0),U),0),U,6),AMHLENG=$P(^AMHTRPT(AMHRPT,12,X,0),U,2),AMHHDR=$E(AMHHDR,1,AMHLENG) D
.S J=$L(AMHHDR),AMHHEAD=AMHHEAD_AMHHDR,K=$P(^AMHTRPT(AMHRPT,12,X,0),U,2)+1 F I=J:1:K S AMHHEAD=AMHHEAD_" "
.Q
S AMHDASH="",$P(AMHDASH,"-",AMHTCW)="-"
D COVPAGE^AMHRLP1 ;print cover page - note: if user ^'s out of cover page, processing continues
PROC ;process printing of report
I AMHCTYP="T" G DONE ;--- if displaying only total, that was done in the cover page - go to done
S AMHPG=0 I '$D(^XTMP("AMHRL",AMHJOB,AMHBTH)) G DONE
S (AMHSRTV,AMHFRST)="" K AMHQUIT
F S AMHSRTV=$O(^XTMP("AMHRL",AMHJOB,AMHBTH,"DATA HITS",AMHSRTV)) Q:AMHSRTV=""!($D(AMHQUIT)) D V
G:$D(AMHQUIT) DONE
I AMHCTYP="F" D WRITEF G DONE
I $Y>(IOSL-4) D HEAD G:$D(AMHQUIT) DONE
I $D(AMHRCNT),AMHPTVS="V" W !!!,"Total ",$S(AMHPTVS="P":"Patients",1:"Visits"),": ",AMHRCNT
I $D(AMHRCNT),AMHPTVS="S" W !!!,"Total Number of Suicide Forms: ",AMHRCNT
W !!,"Total Patients: ",AMHPTCT
DONE ;
D DONE^AMHRLP2
Q
V ;GETS DATA HITS
S AMHSCNT=0
;get readable sort value
S AMHSRTR="",AMHR=$O(^XTMP("AMHRL",AMHJOB,AMHBTH,"DATA HITS",AMHSRTV,"")) I AMHR]"" S AMHCRIT=AMHSORT D
.I AMHPTVS="S" S AMHR0=^AMHPSUIC(AMHR,0),DFN=$P(AMHR0,U,4) X:$D(^AMHSORT(AMHSORT,3)) ^(3) S AMHSRTR=AMHPRNT
.I AMHPTVS="V" S AMHR0=^AMHREC(AMHR,0),DFN=$P(AMHR0,U,8) X:$D(^AMHSORT(AMHSORT,3)) ^(3) S AMHSRTR=AMHPRNT
.I AMHPTVS="P" S DFN=AMHR X:$D(^AMHSORT(AMHSORT,3)) ^(3) S AMHSRTR=AMHPRNT
I $G(AMHSPAG)!($D(AMHFRST)) D HEAD Q:$D(AMHQUIT)
K AMHFRST
S AMHR=0 F S AMHR=$O(^XTMP("AMHRL",AMHJOB,AMHBTH,"DATA HITS",AMHSRTV,AMHR)) Q:AMHR'=+AMHR!($D(AMHQUIT)) D
.I AMHPTVS="V" S AMHR0=^AMHREC(AMHR,0),DFN=$P(AMHR0,U,8) D PRINT Q
.I AMHPTVS="S" S AMHR0=^AMHPSUIC(AMHR,0),DFN=$P(AMHR0,U,4) D PRINT Q
.S DFN=AMHR D PRINT
.Q
Q:$D(AMHQUIT)
I $Y>(IOSL-3) D HEAD Q:$D(AMHQUIT)
;W:$G(AMHSPAG) !!,"SUB-TOTAL for ",AMHSORV," ",AMHSRTR,": ",AMHSCNT
;W:AMHCTYP="S" !?10,$E(AMHSRTR,1,30),?45,$J(AMHSCNT,8)
I $G(AMHSPAG) W !!,"SUB-TOTAL for ",AMHSORV," ",AMHSRTR,": ",AMHSCNT I AMHPTVS="V" W " # of PATIENTS: ",$S($D(^XTMP("AMHRL",AMHJOB,AMHBTH,"SUB PAT COUNT",AMHSRTV)):^XTMP("AMHRL",AMHJOB,AMHBTH,"SUB PAT COUNT",AMHSRTV),1:0)
I AMHCTYP="S",(AMHPTVS="V"!((AMHPTVS="S"))) W !,?10,$E(AMHSRTR,1,30),?45,$J(AMHSCNT,8)," (V)",?60,$S($D(^XTMP("AMHRL",AMHJOB,AMHBTH,"SUB PAT COUNT",AMHSRTV)):$J(^XTMP("AMHRL",AMHJOB,AMHBTH,"SUB PAT COUNT",AMHSRTV),8),1:" 0")," (P)"
I AMHCTYP="S",AMHPTVS="P" W !?10,$E(AMHSRTR,1,30),?45,$J(AMHSCNT,8)
Q
PRINT ;
I AMHCTYP="F" D FLAT Q
S AMHSCNT=AMHSCNT+1 Q:AMHCTYP="S"
K ^XTMP("AMHLINE",$J) S ^XTMP("AMHLINE",$J,1)=""
I $Y>(IOSL-5) D HEAD Q:$D(AMHQUIT)
S AMHI=0 F S AMHI=$O(^AMHTRPT(AMHRPT,12,AMHI)) Q:AMHI'=+AMHI!($D(AMHQUIT)) S AMHCRIT=$P(^AMHTRPT(AMHRPT,12,AMHI,0),U) D
.I '$P(^AMHSORT(AMHCRIT,0),U,8) D SINGLE Q
.D MULT
.Q
S AMHX=0 F S AMHX=$O(^XTMP("AMHLINE",$J,AMHX)) Q:AMHX'=+AMHX!($D(AMHQUIT)) D
.I $Y>(IOSL-4) D HEAD Q:$D(AMHQUIT)
.W !,^XTMP("AMHLINE",$J,AMHX)
Q
SINGLE ;process single valued item
K AMHPRNT
S AMHX=0
X:$D(^AMHSORT(AMHCRIT,3)) ^(3)
S AMHLENG=$P(^AMHTRPT(AMHRPT,12,AMHI,0),U,2),AMHPRNT=$E($G(AMHPRNT),1,AMHLENG) D
.S J=$L(AMHPRNT),^XTMP("AMHLINE",$J,1)=^XTMP("AMHLINE",$J,1)_AMHPRNT,K=$P(^AMHTRPT(AMHRPT,12,AMHI,0),U,2)+1 F I=J:1:K S ^XTMP("AMHLINE",$J,1)=^XTMP("AMHLINE",$J,1)_" "
.S X=1 F S X=$O(^XTMP("AMHLINE",$J,X)) Q:X'=+X I $L(^XTMP("AMHLINE",$J,X))<$L(^XTMP("AMHLINE",$J,1)) S K=$L(^XTMP("AMHLINE",$J,X))+1,J=$L(^XTMP("AMHLINE",$J,1)) F I=K:1:J S ^XTMP("AMHLINE",$J,X)=^XTMP("AMHLINE",$J,X)_" "
Q
MULT ;
K AMHPRNT,AMHPRNM S (AMHX,AMHPCNT)=0
X:$D(^AMHSORT(AMHCRIT,3)) ^(3)
I '$D(AMHPRNM) S AMHPRNT="--" D
.S AMHLENG=$P(^AMHTRPT(AMHRPT,12,AMHI,0),U,2),AMHPRNT=$E(AMHPRNT,1,AMHLENG) D
..S J=$L(AMHPRNT),^XTMP("AMHLINE",$J,1)=^XTMP("AMHLINE",$J,1)_AMHPRNT,K=$P(^AMHTRPT(AMHRPT,12,AMHI,0),U,2)+1 F I=J:1:K S ^XTMP("AMHLINE",$J,1)=^XTMP("AMHLINE",$J,1)_" "
S X=0 F S X=$O(AMHPRNM(X)) Q:X'=+X D
.I X=1 D Q
..S AMHLENG=$P(^AMHTRPT(AMHRPT,12,AMHI,0),U,2),AMHPRNT=$E(AMHPRNM(1),1,AMHLENG) D
...S J=$L(AMHPRNT),^XTMP("AMHLINE",$J,1)=^XTMP("AMHLINE",$J,1)_AMHPRNT,K=$P(^AMHTRPT(AMHRPT,12,AMHI,0),U,2)+1 F I=J:1:K S ^XTMP("AMHLINE",$J,1)=^XTMP("AMHLINE",$J,1)_" "
.S AMHLENG=$P(^AMHTRPT(AMHRPT,12,AMHI,0),U,2),AMHPRNT=$E(AMHPRNM(X),1,AMHLENG) D
..I '$D(^XTMP("AMHLINE",$J,X)) S ^XTMP("AMHLINE",$J,X)="",K=$P(^AMHTRPT(AMHRPT,12,AMHI,0),U,2)+1,$P(^XTMP("AMHLINE",$J,X)," ",($L(^XTMP("AMHLINE",$J,1))-K))=""
..S J=$L(AMHPRNT),^XTMP("AMHLINE",$J,X)=^XTMP("AMHLINE",$J,X)_AMHPRNT,K=$P(^AMHTRPT(AMHRPT,12,AMHI,0),U,2)+1 F I=J:1:K S ^XTMP("AMHLINE",$J,X)=^XTMP("AMHLINE",$J,X)_" "
S X=1 F S X=$O(^XTMP("AMHLINE",$J,X)) Q:X'=+X I $L(^XTMP("AMHLINE",$J,X))<$L(^XTMP("AMHLINE",$J,1)) S K=$L(^XTMP("AMHLINE",$J,X))+1,J=$L(^XTMP("AMHLINE",$J,1)) F I=K:1:J S ^XTMP("AMHLINE",$J,X)=^XTMP("AMHLINE",$J,X)_" "
Q
DIQ ;
I DA="" S AMHPRNT="--" Q
K AMHPRNT,AMHFILE,AMHFIEL
S AMHFILE=$P($P(^AMHSORT(AMHCRIT,0),U,4),","),AMHFIEL=$P($P(^(0),U,4),",",2)
S DIQ(0)="EN",DIQ="AMHPRNT(",DIC=AMHFILE,DR=AMHFIEL D EN^DIQ1 K DIC,DR,DIQ
I '$D(AMHPRNT(AMHFILE,DA,AMHFIEL,"E")) S AMHPRNT(AMHFILE,DA,AMHFIEL,"E")="--"
S AMHPRNT=AMHPRNT(AMHFILE,DA,AMHFIEL,"E")
Q
FLAT ;
S AMHREC=AMHR0
D FLAT^AMHRLP3
S ^XTMP($J,"AMHFLAT",AMHR)=AMHTX
K AMHTX,AMHREC,X
Q
HEAD ;ENTRY POINT
Q:AMHCTYP="F"
D HEAD^AMHRLP2
Q
WRITEF ;write flat file from global
D WRITEF^AMHRLP2
Q
AMHRLP ; IHS/CMI/LAB - TUCSON-OHPRD/LAB - PRINT BH RECORD REPORT ;
+1 ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
START ;EP - Set up header line, dash line
+1 ;just in case
KILL ^XTMP("AMHFLAT",$JOB)
+2 SET X=0
SET AMHHEAD=""
FOR
SET X=$ORDER(^AMHTRPT(AMHRPT,12,X))
IF X'=+X
QUIT
SET AMHHDR=$PIECE(^AMHSORT($PIECE(^AMHTRPT(AMHRPT,12,X,0),U),0),U,6)
SET AMHLENG=$PIECE(^AMHTRPT(AMHRPT,12,X,0),U,2)
SET AMHHDR=$EXTRACT(AMHHDR,1,AMHLENG)
Begin DoDot:1
+3 SET J=$LENGTH(AMHHDR)
SET AMHHEAD=AMHHEAD_AMHHDR
SET K=$PIECE(^AMHTRPT(AMHRPT,12,X,0),U,2)+1
FOR I=J:1:K
SET AMHHEAD=AMHHEAD_" "
+4 QUIT
End DoDot:1
+5 SET AMHDASH=""
SET $PIECE(AMHDASH,"-",AMHTCW)="-"
+6 ;print cover page - note: if user ^'s out of cover page, processing continues
DO COVPAGE^AMHRLP1
PROC ;process printing of report
+1 ;--- if displaying only total, that was done in the cover page - go to done
IF AMHCTYP="T"
GOTO DONE
+2 SET AMHPG=0
IF '$DATA(^XTMP("AMHRL",AMHJOB,AMHBTH))
GOTO DONE
+3 SET (AMHSRTV,AMHFRST)=""
KILL AMHQUIT
+4 FOR
SET AMHSRTV=$ORDER(^XTMP("AMHRL",AMHJOB,AMHBTH,"DATA HITS",AMHSRTV))
IF AMHSRTV=""!($DATA(AMHQUIT))
QUIT
DO V
+5 IF $DATA(AMHQUIT)
GOTO DONE
+6 IF AMHCTYP="F"
DO WRITEF
GOTO DONE
+7 IF $Y>(IOSL-4)
DO HEAD
IF $DATA(AMHQUIT)
GOTO DONE
+8 IF $DATA(AMHRCNT)
IF AMHPTVS="V"
WRITE !!!,"Total ",$SELECT(AMHPTVS="P":"Patients",1:"Visits"),": ",AMHRCNT
+9 IF $DATA(AMHRCNT)
IF AMHPTVS="S"
WRITE !!!,"Total Number of Suicide Forms: ",AMHRCNT
+10 WRITE !!,"Total Patients: ",AMHPTCT
DONE ;
+1 DO DONE^AMHRLP2
+2 QUIT
V ;GETS DATA HITS
+1 SET AMHSCNT=0
+2 ;get readable sort value
+3 SET AMHSRTR=""
SET AMHR=$ORDER(^XTMP("AMHRL",AMHJOB,AMHBTH,"DATA HITS",AMHSRTV,""))
IF AMHR]""
SET AMHCRIT=AMHSORT
Begin DoDot:1
+4 IF AMHPTVS="S"
SET AMHR0=^AMHPSUIC(AMHR,0)
SET DFN=$PIECE(AMHR0,U,4)
IF $DATA(^AMHSORT(AMHSORT,3))
XECUTE ^(3)
SET AMHSRTR=AMHPRNT
+5 IF AMHPTVS="V"
SET AMHR0=^AMHREC(AMHR,0)
SET DFN=$PIECE(AMHR0,U,8)
IF $DATA(^AMHSORT(AMHSORT,3))
XECUTE ^(3)
SET AMHSRTR=AMHPRNT
+6 IF AMHPTVS="P"
SET DFN=AMHR
IF $DATA(^AMHSORT(AMHSORT,3))
XECUTE ^(3)
SET AMHSRTR=AMHPRNT
End DoDot:1
+7 IF $GET(AMHSPAG)!($DATA(AMHFRST))
DO HEAD
IF $DATA(AMHQUIT)
QUIT
+8 KILL AMHFRST
+9 SET AMHR=0
FOR
SET AMHR=$ORDER(^XTMP("AMHRL",AMHJOB,AMHBTH,"DATA HITS",AMHSRTV,AMHR))
IF AMHR'=+AMHR!($DATA(AMHQUIT))
QUIT
Begin DoDot:1
+10 IF AMHPTVS="V"
SET AMHR0=^AMHREC(AMHR,0)
SET DFN=$PIECE(AMHR0,U,8)
DO PRINT
QUIT
+11 IF AMHPTVS="S"
SET AMHR0=^AMHPSUIC(AMHR,0)
SET DFN=$PIECE(AMHR0,U,4)
DO PRINT
QUIT
+12 SET DFN=AMHR
DO PRINT
+13 QUIT
End DoDot:1
+14 IF $DATA(AMHQUIT)
QUIT
+15 IF $Y>(IOSL-3)
DO HEAD
IF $DATA(AMHQUIT)
QUIT
+16 ;W:$G(AMHSPAG) !!,"SUB-TOTAL for ",AMHSORV," ",AMHSRTR,": ",AMHSCNT
+17 ;W:AMHCTYP="S" !?10,$E(AMHSRTR,1,30),?45,$J(AMHSCNT,8)
+18 IF $GET(AMHSPAG)
WRITE !!,"SUB-TOTAL for ",AMHSORV," ",AMHSRTR,": ",AMHSCNT
IF AMHPTVS="V"
WRITE " # of PATIENTS: ",$SELECT($DATA(^XTMP("AMHRL",AMHJOB,AMHBTH,"SUB PAT COUNT",AMHSRTV)):^XTMP("AMHRL",AMHJOB,AMHBTH,"SUB PAT COUNT",AMHSRTV),1:0)
+19 IF AMHCTYP="S"
IF (AMHPTVS="V"!((AMHPTVS="S")))
WRITE !,?10,$EXTRACT(AMHSRTR,1,30),?45,$JUSTIFY(AMHSCNT,8)," (V)",?60,$SELECT($DATA(^XTMP("AMHRL",AMHJOB,AMHBTH,"SUB PAT COUNT",AMHSRTV)):$JUSTIFY(^XTMP("AMHRL",AMHJOB,AMHBTH,"SUB PAT COUNT",AMHSRTV),8),1:" 0")," (P)"
+20 IF AMHCTYP="S"
IF AMHPTVS="P"
WRITE !?10,$EXTRACT(AMHSRTR,1,30),?45,$JUSTIFY(AMHSCNT,8)
+21 QUIT
PRINT ;
+1 IF AMHCTYP="F"
DO FLAT
QUIT
+2 SET AMHSCNT=AMHSCNT+1
IF AMHCTYP="S"
QUIT
+3 KILL ^XTMP("AMHLINE",$JOB)
SET ^XTMP("AMHLINE",$JOB,1)=""
+4 IF $Y>(IOSL-5)
DO HEAD
IF $DATA(AMHQUIT)
QUIT
+5 SET AMHI=0
FOR
SET AMHI=$ORDER(^AMHTRPT(AMHRPT,12,AMHI))
IF AMHI'=+AMHI!($DATA(AMHQUIT))
QUIT
SET AMHCRIT=$PIECE(^AMHTRPT(AMHRPT,12,AMHI,0),U)
Begin DoDot:1
+6 IF '$PIECE(^AMHSORT(AMHCRIT,0),U,8)
DO SINGLE
QUIT
+7 DO MULT
+8 QUIT
End DoDot:1
+9 SET AMHX=0
FOR
SET AMHX=$ORDER(^XTMP("AMHLINE",$JOB,AMHX))
IF AMHX'=+AMHX!($DATA(AMHQUIT))
QUIT
Begin DoDot:1
+10 IF $Y>(IOSL-4)
DO HEAD
IF $DATA(AMHQUIT)
QUIT
+11 WRITE !,^XTMP("AMHLINE",$JOB,AMHX)
End DoDot:1
+12 QUIT
SINGLE ;process single valued item
+1 KILL AMHPRNT
+2 SET AMHX=0
+3 IF $DATA(^AMHSORT(AMHCRIT,3))
XECUTE ^(3)
+4 SET AMHLENG=$PIECE(^AMHTRPT(AMHRPT,12,AMHI,0),U,2)
SET AMHPRNT=$EXTRACT($GET(AMHPRNT),1,AMHLENG)
Begin DoDot:1
+5 SET J=$LENGTH(AMHPRNT)
SET ^XTMP("AMHLINE",$JOB,1)=^XTMP("AMHLINE",$JOB,1)_AMHPRNT
SET K=$PIECE(^AMHTRPT(AMHRPT,12,AMHI,0),U,2)+1
FOR I=J:1:K
SET ^XTMP("AMHLINE",$JOB,1)=^XTMP("AMHLINE",$JOB,1)_" "
+6 SET X=1
FOR
SET X=$ORDER(^XTMP("AMHLINE",$JOB,X))
IF X'=+X
QUIT
IF $LENGTH(^XTMP("AMHLINE",$JOB,X))<$LENGTH(^XTMP("AMHLINE",$JOB,1))
SET K=$LENGTH(^XTMP("AMHLINE",$JOB,X))+1
SET J=$LENGTH(^XTMP("AMHLINE",$JOB,1))
FOR I=K:1:J
SET ^XTMP("AMHLINE",$JOB,X)=^XTMP("AMHLINE",$JOB,X)_" "
End DoDot:1
+7 QUIT
MULT ;
+1 KILL AMHPRNT,AMHPRNM
SET (AMHX,AMHPCNT)=0
+2 IF $DATA(^AMHSORT(AMHCRIT,3))
XECUTE ^(3)
+3 IF '$DATA(AMHPRNM)
SET AMHPRNT="--"
Begin DoDot:1
+4 SET AMHLENG=$PIECE(^AMHTRPT(AMHRPT,12,AMHI,0),U,2)
SET AMHPRNT=$EXTRACT(AMHPRNT,1,AMHLENG)
Begin DoDot:2
+5 SET J=$LENGTH(AMHPRNT)
SET ^XTMP("AMHLINE",$JOB,1)=^XTMP("AMHLINE",$JOB,1)_AMHPRNT
SET K=$PIECE(^AMHTRPT(AMHRPT,12,AMHI,0),U,2)+1
FOR I=J:1:K
SET ^XTMP("AMHLINE",$JOB,1)=^XTMP("AMHLINE",$JOB,1)_" "
End DoDot:2
End DoDot:1
+6 SET X=0
FOR
SET X=$ORDER(AMHPRNM(X))
IF X'=+X
QUIT
Begin DoDot:1
+7 IF X=1
Begin DoDot:2
+8 SET AMHLENG=$PIECE(^AMHTRPT(AMHRPT,12,AMHI,0),U,2)
SET AMHPRNT=$EXTRACT(AMHPRNM(1),1,AMHLENG)
Begin DoDot:3
+9 SET J=$LENGTH(AMHPRNT)
SET ^XTMP("AMHLINE",$JOB,1)=^XTMP("AMHLINE",$JOB,1)_AMHPRNT
SET K=$PIECE(^AMHTRPT(AMHRPT,12,AMHI,0),U,2)+1
FOR I=J:1:K
SET ^XTMP("AMHLINE",$JOB,1)=^XTMP("AMHLINE",$JOB,1)_" "
End DoDot:3
End DoDot:2
QUIT
+10 SET AMHLENG=$PIECE(^AMHTRPT(AMHRPT,12,AMHI,0),U,2)
SET AMHPRNT=$EXTRACT(AMHPRNM(X),1,AMHLENG)
Begin DoDot:2
+11 IF '$DATA(^XTMP("AMHLINE",$JOB,X))
SET ^XTMP("AMHLINE",$JOB,X)=""
SET K=$PIECE(^AMHTRPT(AMHRPT,12,AMHI,0),U,2)+1
SET $PIECE(^XTMP("AMHLINE",$JOB,X)," ",($LENGTH(^XTMP("AMHLINE",$JOB,1))-K))=""
+12 SET J=$LENGTH(AMHPRNT)
SET ^XTMP("AMHLINE",$JOB,X)=^XTMP("AMHLINE",$JOB,X)_AMHPRNT
SET K=$PIECE(^AMHTRPT(AMHRPT,12,AMHI,0),U,2)+1
FOR I=J:1:K
SET ^XTMP("AMHLINE",$JOB,X)=^XTMP("AMHLINE",$JOB,X)_" "
End DoDot:2
End DoDot:1
+13 SET X=1
FOR
SET X=$ORDER(^XTMP("AMHLINE",$JOB,X))
IF X'=+X
QUIT
IF $LENGTH(^XTMP("AMHLINE",$JOB,X))<$LENGTH(^XTMP("AMHLINE",$JOB,1))
SET K=$LENGTH(^XTMP("AMHLINE",$JOB,X))+1
SET J=$LENGTH(^XTMP("AMHLINE",$JOB,1))
FOR I=K:1:J
SET ^XTMP("AMHLINE",$JOB,X)=^XTMP("AMHLINE",$JOB,X)_" "
+14 QUIT
DIQ ;
+1 IF DA=""
SET AMHPRNT="--"
QUIT
+2 KILL AMHPRNT,AMHFILE,AMHFIEL
+3 SET AMHFILE=$PIECE($PIECE(^AMHSORT(AMHCRIT,0),U,4),",")
SET AMHFIEL=$PIECE($PIECE(^(0),U,4),",",2)
+4 SET DIQ(0)="EN"
SET DIQ="AMHPRNT("
SET DIC=AMHFILE
SET DR=AMHFIEL
DO EN^DIQ1
KILL DIC,DR,DIQ
+5 IF '$DATA(AMHPRNT(AMHFILE,DA,AMHFIEL,"E"))
SET AMHPRNT(AMHFILE,DA,AMHFIEL,"E")="--"
+6 SET AMHPRNT=AMHPRNT(AMHFILE,DA,AMHFIEL,"E")
+7 QUIT
FLAT ;
+1 SET AMHREC=AMHR0
+2 DO FLAT^AMHRLP3
+3 SET ^XTMP($JOB,"AMHFLAT",AMHR)=AMHTX
+4 KILL AMHTX,AMHREC,X
+5 QUIT
HEAD ;ENTRY POINT
+1 IF AMHCTYP="F"
QUIT
+2 DO HEAD^AMHRLP2
+3 QUIT
WRITEF ;write flat file from global
+1 DO WRITEF^AMHRLP2
+2 QUIT
