ABPAOPHD.m

ABPAOPHD ;POSTING LOG REPORT HEADER; [ 03/10/91  4:31 PM ]

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

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

NXTX S X=$O(ABPA("HD",X)) G:+X=0 MOVE

 S AU("MAX")=X G NXTX

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

 S XX="",$P(XX,"*",80)=""

 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

 D ^%AUCLS

 W "RUN DATE: ",RUNDT,?(79-($L(PG))),PG,!,XX

 F I=1:1:AU("MAX") D

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

 W !,XX S X="FROM: "_FC W !!?(40-($L(X)/2)),X

 W !!,"THE FOLLOWING ENTRIES HAVE BEEN ADDED TO YOUR DATABASE:"

 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

ABPAOPHD  ;POSTING LOG REPORT HEADER; [ 03/10/91  4:31 PM ]

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

START      SET X=0

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

NXTX       SET X=$ORDER(ABPA("HD",X))

           IF +X=0

               GOTO MOVE

 +1        SET AU("MAX")=X

           GOTO NXTX

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

 +2        SET XX=""

           SET $PIECE(XX,"*",80)=""

 +3        DO NOW^%DTC

           SET Y=%

           XECUTE ^DD("DD")

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

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

 +5        SET ABPAPG=ABPAPG+1

           SET PG="PAGE: "_ABPAPG

 +6        DO ^%AUCLS

 +7        WRITE "RUN DATE: ",RUNDT,?(79-($LENGTH(PG))),PG,!,XX

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

               Begin DoDot:1

 +9                WRITE !,"*",?40-(($LENGTH(ABPA("HD",I))/2)),ABPA("HD",I),?78,"*"

               End DoDot:1

 +10       WRITE !,XX

           SET X="FROM: "_FC

           WRITE !!?(40-($LENGTH(X)/2)),X

 +11       WRITE !!,"THE FOLLOWING ENTRIES HAVE BEEN ADDED TO YOUR DATABASE:"

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

 +13       FOR I=3:1

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

                   QUIT 

               Begin DoDot:1

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

               End DoDot:1

               KILL ABPA("HD",I)

QUIT       QUIT