- 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 ---[H[J[2J[HECTFCPB 869 printed Jan 18, 2025@03:03:36 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 ;