ECTFCPB.m

ECTFCPB ;B'ham ISC/PTD-Display Control Point Official's Balance ;01/29/91 08:00

V ;;1.05;INTERIM MANAGEMENT SUPPORT;;

 I '$D(^PRCS(410)) W *7,!!?29,"OPTION IS UNAVAILABLE!",!,"The 'Control Point Activity' File - #410 is not loaded on your system.",!! S XQUIT="" Q

 I '$O(^PRCS(410,0)) W *7,!!,"'Control Point Activity' File - #410 has not been populated on your system.",!! S XQUIT="" Q

 ;CHECK VERSION OF IFCAP ON SYSTEM

 S VER="",PKGDA=$O(^DIC(9.4,"C","PRC",0)) S:'PKGDA XQUIT="" G:'PKGDA EXIT S:$D(^DIC(9.4,PKGDA,"VERSION")) VER=$P(^("VERSION"),"^") S RTN=$S(VER<3:"^PRCFBRBR",1:"^PRCBRBR")

 S X=$P(RTN,"^",2) X ^%ZOSF("TEST") I $T=0 W *7,!!,RTN," routine does not exist on your system!" G EXIT

 K %ZIS S IOP="HOME" D ^%ZIS K %ZIS,IOP W @IOF,!!

 ;DIRECT CALL TO EXTERNAL ROUTINE

 D @RTN

EXIT K C,DA,DATETIME,J,LINE,PAGE,PKGDA,POP,PRC,RTN,VER,X,ZZ

 Q

 ;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---ECTFCPB   869     printed  Apr 09, 2024@21:04:51                                                                                                                                                                                                      Page 2

ECTFCPB   ;B'ham ISC/PTD-Display Control Point Official's Balance ;01/29/91 08:00

V         ;;1.05;INTERIM MANAGEMENT SUPPORT;;

 +1        IF '$DATA(^PRCS(410))

               WRITE *7,!!?29,"OPTION IS UNAVAILABLE!",!,"The 'Control Point Activity' File - #410 is not loaded on your system.",!!

               SET XQUIT=""

               QUIT 

 +2        IF '$ORDER(^PRCS(410,0))

               WRITE *7,!!,"'Control Point Activity' File - #410 has not been populated on your system.",!!

               SET XQUIT=""

               QUIT 

 +3       ;CHECK VERSION OF IFCAP ON SYSTEM

 +4        SET VER=""

           SET PKGDA=$ORDER(^DIC(9.4,"C","PRC",0))

           if 'PKGDA

               SET XQUIT=""

           if 'PKGDA

               GOTO EXIT

           if $DATA(^DIC(9.4,PKGDA,"VERSION"))

               SET VER=$PIECE(^("VERSION"),"^")

           SET RTN=$SELECT(VER<3:"^PRCFBRBR",1:"^PRCBRBR")

 +5        SET X=$PIECE(RTN,"^",2)

           XECUTE ^%ZOSF("TEST")

           IF $TEST=0

               WRITE *7,!!,RTN," routine does not exist on your system!"

               GOTO EXIT

 +6        KILL %ZIS

           SET IOP="HOME"

           DO ^%ZIS

           KILL %ZIS,IOP

           WRITE @IOF,!!

 +7       ;DIRECT CALL TO EXTERNAL ROUTINE

 +8        DO @RTN

EXIT       KILL C,DA,DATETIME,J,LINE,PAGE,PKGDA,POP,PRC,RTN,VER,X,ZZ

 +1        QUIT 

 +2       ;