Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ABPAOPHD

ABPAOPHD.m

Go to the documentation of this file.
  1. 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
  1. START S X=0,SITENAME=$P(^DIC(4,DUZ(2),0),"^",1)
  1. NXTX S X=$O(ABPA("HD",X)) G:+X=0 MOVE
  1. S AU("MAX")=X G NXTX
  1. MOVE F I=AU("MAX"):-1:1 S ABPA("HD",I+2)=ABPA("HD",I)
  1. WRITE S ABPA("HD",1)=SITENAME,$P(AU("LINE"),"-",$L(SITENAME)+1)=""
  1. S ABPA("HD",2)=AU("LINE"),AU("MAX")=AU("MAX")+2
  1. S XX="",$P(XX,"*",80)=""
  1. D NOW^%DTC S Y=% X ^DD("DD") S RUNTM=$P(Y,"@",2)
  1. S RUNDT=+%I(1)_"/"_+%I(2)_"/"_+$E(+%I(3),2,3)_" AT "_RUNTM
  1. S ABPAPG=ABPAPG+1 S PG="PAGE: "_ABPAPG
  1. D ^%AUCLS
  1. W "RUN DATE: ",RUNDT,?(79-($L(PG))),PG,!,XX
  1. F I=1:1:AU("MAX") D
  1. .W !,"*",?40-(($L(ABPA("HD",I))/2)),ABPA("HD",I),?78,"*"
  1. W !,XX S X="FROM: "_FC W !!?(40-($L(X)/2)),X
  1. W !!,"THE FOLLOWING ENTRIES HAVE BEEN ADDED TO YOUR DATABASE:"
  1. K X,Y,I,AU("MAX"),SITENAME,XX,AU("LINE"),RUNDT,RUNTM,PG
  1. F I=3:1 Q:$D(ABPA("HD",I))=0 D K ABPA("HD",I)
  1. .S ABPA("HD",(I-2))=ABPA("HD",I)
  1. QUIT Q