- ECTFCPO ;B'ham ISC/PTD-Fund Control Point Officials ;01/29/91 08:00
- V ;;1.05;INTERIM MANAGEMENT SUPPORT;**15**;
- I '$D(^PRC(420)) W *7,!!?29,"OPTION IS UNAVAILABLE!",!,"The 'Fund Control Point' File - #420 is not loaded on your system.",!! S XQUIT="" Q
- I '$O(^PRC(420,0)) W *7,!!,"'Fund Control Point' File - #420 has not been populated on your system.",!! S XQUIT="" Q
- S CNT=0 F J=0:0 S J=$O(^PRC(420,J)) Q:'J S CNT=CNT+1
- DIC I CNT>1 W !! S DIC="^PRC(420,",DIC(0)="QEANM",DIC("A")="Select STATION number: " D ^DIC G:Y<0 EXIT S STNUM=+Y
- I CNT=1 S STNUM=$O(^PRC(420,0))
- DIP S DIC="^PRC(420,",BY=".01,1,.01,1,6,@1",(FR,TO)=STNUM_",,"_1,FLDS="1,.01,.5;C25,6,.01;C50;""CONTROL POINT OFFICIAL""",L=0
- S DHD="FUND CONTROL POINT OFFICIAL LIST" D EN1^DIP
- EXIT K B,BY,CNT,DHD,DIC,FLDS,FR,J,L,STNUM,TO,X,Y
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECTFCPO 818 printed Feb 18, 2025@23:28:46 Page 2
- ECTFCPO ;B'ham ISC/PTD-Fund Control Point Officials ;01/29/91 08:00
- V ;;1.05;INTERIM MANAGEMENT SUPPORT;**15**;
- +1 IF '$DATA(^PRC(420))
- WRITE *7,!!?29,"OPTION IS UNAVAILABLE!",!,"The 'Fund Control Point' File - #420 is not loaded on your system.",!!
- SET XQUIT=""
- QUIT
- +2 IF '$ORDER(^PRC(420,0))
- WRITE *7,!!,"'Fund Control Point' File - #420 has not been populated on your system.",!!
- SET XQUIT=""
- QUIT
- +3 SET CNT=0
- FOR J=0:0
- SET J=$ORDER(^PRC(420,J))
- if 'J
- QUIT
- SET CNT=CNT+1
- DIC IF CNT>1
- WRITE !!
- SET DIC="^PRC(420,"
- SET DIC(0)="QEANM"
- SET DIC("A")="Select STATION number: "
- DO ^DIC
- if Y<0
- GOTO EXIT
- SET STNUM=+Y
- +1 IF CNT=1
- SET STNUM=$ORDER(^PRC(420,0))
- DIP SET DIC="^PRC(420,"
- SET BY=".01,1,.01,1,6,@1"
- SET (FR,TO)=STNUM_",,"_1
- SET FLDS="1,.01,.5;C25,6,.01;C50;""CONTROL POINT OFFICIAL"""
- SET L=0
- +1 SET DHD="FUND CONTROL POINT OFFICIAL LIST"
- DO EN1^DIP
- EXIT KILL B,BY,CNT,DHD,DIC,FLDS,FR,J,L,STNUM,TO,X,Y
- +1 QUIT
- +2 ;