ABPARPTH.m

ABPARPTH ;STANDARD REPORT HEADER; [ 02/06/91  12:13 PM ]

 ;;1.4;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;JULY 25, 1991

 ;

 ;PREREQUISITES: 1) ABPA("HD") ARRAY MUST BE DEFINED IN RANGE 1..N

 ;               2) DUZ(2) MUST BE DEFINED

 ;               3) ABPAPG MUST BE DEFINED AS PAGE COUNTER

 ;

START S X=0,SITENAME=$P(^DIC(4,DUZ(2),0),"^",1)

NXTX F I=0:0 D  Q:+X=0

 .S X=$O(ABPA("HD",X)) Q:+X=0  S AU("MAX")=X

MOVE F I=AU("MAX"):-1:1 S ABPA("HD",I+2)=ABPA("HD",I)

WRITE S ABPA("HD",1)=SITENAME,$P(AU("LINE"),"-",$L(SITENAME)+1)=""

 S ABPA("HD",2)=AU("LINE"),AU("MAX")=AU("MAX")+2,$P(XX,"*",+IOM)=""

 D NOW^%DTC S Y=% X ^DD("DD") S RUNTM=$P(Y,"@",2)

 S RUNDT=+%I(1)_"/"_+%I(2)_"/"_+$E(+%I(3),2,3)_" AT "_RUNTM

 S ABPAPG=ABPAPG+1 S PG="PAGE: "_ABPAPG W @IOF

 W "RUN DATE: ",RUNDT I $D(ZTSK)=1 D

 .S X="(Task #"_ZTSK_")"

 .W ?((+IOM/2)-($L(X)/2)),X

 W ?((+IOM-1)-($L(PG))),PG,!,XX

 F I=1:1:AU("MAX") D  W:I=AU("MAX") !,XX

 .W !,"*",?(+IOM/2)-(($L(ABPA("HD",I))/2)),ABPA("HD",I),?(+IOM-2),"*"

 W ! K X,Y,I,AU("MAX"),SITENAME,XX,AU("LINE"),RUNDT,RUNTM,PG

 F I=3:1 Q:$D(ABPA("HD",I))=0  D  K ABPA("HD",I)

 .S ABPA("HD",(I-2))=ABPA("HD",I)

QUIT Q

ABPARPTH  ;STANDARD REPORT HEADER; [ 02/06/91  12:13 PM ]

 +1       ;;1.4;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;JULY 25, 1991

 +2       ;

 +3       ;PREREQUISITES: 1) ABPA("HD") ARRAY MUST BE DEFINED IN RANGE 1..N

 +4       ;               2) DUZ(2) MUST BE DEFINED

 +5       ;               3) ABPAPG MUST BE DEFINED AS PAGE COUNTER

 +6       ;

START      SET X=0

           SET SITENAME=$PIECE(^DIC(4,DUZ(2),0),"^",1)

NXTX       FOR I=0:0

               Begin DoDot:1

 +1                SET X=$ORDER(ABPA("HD",X))

                   IF +X=0

                       QUIT 

                   SET AU("MAX")=X

               End DoDot:1

               IF +X=0

                   QUIT 

MOVE       FOR I=AU("MAX"):-1:1

               SET ABPA("HD",I+2)=ABPA("HD",I)

WRITE      SET ABPA("HD",1)=SITENAME

           SET $PIECE(AU("LINE"),"-",$LENGTH(SITENAME)+1)=""

 +1        SET ABPA("HD",2)=AU("LINE")

           SET AU("MAX")=AU("MAX")+2

           SET $PIECE(XX,"*",+IOM)=""

 +2        DO NOW^%DTC

           SET Y=%

           XECUTE ^DD("DD")

           SET RUNTM=$PIECE(Y,"@",2)

 +3        SET RUNDT=+%I(1)_"/"_+%I(2)_"/"_+$EXTRACT(+%I(3),2,3)_" AT "_RUNTM

 +4        SET ABPAPG=ABPAPG+1

           SET PG="PAGE: "_ABPAPG

           WRITE @IOF

 +5        WRITE "RUN DATE: ",RUNDT

           IF $DATA(ZTSK)=1

               Begin DoDot:1

 +6                SET X="(Task #"_ZTSK_")"

 +7                WRITE ?((+IOM/2)-($LENGTH(X)/2)),X

               End DoDot:1

 +8        WRITE ?((+IOM-1)-($LENGTH(PG))),PG,!,XX

 +9        FOR I=1:1:AU("MAX")

               Begin DoDot:1

 +10               WRITE !,"*",?(+IOM/2)-(($LENGTH(ABPA("HD",I))/2)),ABPA("HD",I),?(+IOM-2),"*"

               End DoDot:1

               IF I=AU("MAX")

                   WRITE !,XX

 +11       WRITE !

           KILL X,Y,I,AU("MAX"),SITENAME,XX,AU("LINE"),RUNDT,RUNTM,PG

 +12       FOR I=3:1

               IF $DATA(ABPA("HD",I))=0

                   QUIT 

               Begin DoDot:1

 +13               SET ABPA("HD",(I-2))=ABPA("HD",I)

               End DoDot:1

               KILL ABPA("HD",I)

QUIT       QUIT