APCPBAN.m

APCPBAN ; IHS/TUCSON/LAB - BANNER FOR PCC DATA TRANSMISSION AUGUST 14, 1992 ; [ 04/03/98  08:39 AM ]

 ;;2.0;IHS PCC DATA EXTRACTION SYSTEM;;APR 03, 1998

V ; GET VERSION

 S APCP("VERSION")="",APCP("VERSION")=$O(^DIC(9.4,"C","APCP",APCP("VERSION"))),APCP("VERSION")=^DIC(9.4,APCP("VERSION"),"VERSION")

 I $G(APCPTEXT)="" S APCPTEXT="TEXT",APCPLINE=3 G PRINT

 S APCPTEXT="TEXT"_APCPTEXT

 F APCPJ=1:1 S APCPX=$T(@APCPTEXT+APCPJ),APCPX=$P(APCPX,";;",2) Q:APCPX="QUIT"!(APCPX="")  S APCPLINE=APCPJ

PRINT W:$D(IOF) @IOF

 F APCPJ=1:1:APCPLINE S APCPX=$T(@APCPTEXT+APCPJ),APCPX=$P(APCPX,";;",2) W !?80-$L(APCPX)\2,APCPX K APCPX

 W !?80-(8+$L(APCP("VERSION")))/2,"Version ",APCP("VERSION")

SITE G XIT:'$D(DUZ(2)) G:'DUZ(2) XIT S APCP("SITE")=$P(^DIC(4,DUZ(2),0),"^") W !!?80-$L(APCP("SITE"))\2,APCP("SITE")

XIT ;

 K DIC,DA,X,Y,%Y,%,APCPJ,APCPX,APCPTEXT,APCPLINE

 Q

TEXT ;

 ;;****************************************

 ;;**       PCC Data Transmission        **

 ;;****************************************

 Q

TEXTR ;

 ;;**************************************

 ;;**   PCC Data Transmission Module   **

 ;;**          REPORTS MODULE          **

 ;;**************************************

 Q

APCPBAN   ; IHS/TUCSON/LAB - BANNER FOR PCC DATA TRANSMISSION AUGUST 14, 1992 ; [ 04/03/98  08:39 AM ]

 +1       ;;2.0;IHS PCC DATA EXTRACTION SYSTEM;;APR 03, 1998

V         ; GET VERSION

 +1        SET APCP("VERSION")=""

           SET APCP("VERSION")=$ORDER(^DIC(9.4,"C","APCP",APCP("VERSION")))

           SET APCP("VERSION")=^DIC(9.4,APCP("VERSION"),"VERSION")

 +2        IF $GET(APCPTEXT)=""

               SET APCPTEXT="TEXT"

               SET APCPLINE=3

               GOTO PRINT

 +3        SET APCPTEXT="TEXT"_APCPTEXT

 +4        FOR APCPJ=1:1

               SET APCPX=$TEXT(@APCPTEXT+APCPJ)

               SET APCPX=$PIECE(APCPX,";;",2)

               IF APCPX="QUIT"!(APCPX="")

                   QUIT 

               SET APCPLINE=APCPJ

PRINT      IF $DATA(IOF)

               WRITE @IOF

 +1        FOR APCPJ=1:1:APCPLINE

               SET APCPX=$TEXT(@APCPTEXT+APCPJ)

               SET APCPX=$PIECE(APCPX,";;",2)

               WRITE !?80-$LENGTH(APCPX)\2,APCPX

               KILL APCPX

 +2        WRITE !?80-(8+$LENGTH(APCP("VERSION")))/2,"Version ",APCP("VERSION")

SITE       IF '$DATA(DUZ(2))

               GOTO XIT

           IF 'DUZ(2)

               GOTO XIT

           SET APCP("SITE")=$PIECE(^DIC(4,DUZ(2),0),"^")

           WRITE !!?80-$LENGTH(APCP("SITE"))\2,APCP("SITE")

XIT       ;

 +1        KILL DIC,DA,X,Y,%Y,%,APCPJ,APCPX,APCPTEXT,APCPLINE

 +2        QUIT 

TEXT      ;

 +1       ;;****************************************

 +2       ;;**       PCC Data Transmission        **

 +3       ;;****************************************

 +4        QUIT 

TEXTR     ;

 +1       ;;**************************************

 +2       ;;**   PCC Data Transmission Module   **

 +3       ;;**          REPORTS MODULE          **

 +4       ;;**************************************

 +5        QUIT