AMHRLP.m

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