ORWPFSS0 ;SCL/GDU - CPRS PFSS Parameter Maintainance;[02/24/05 13:13] ;2/28/05  09:51
 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**215**;Dec 17, 1997
 ;Routine to maintain the ORWPFSS ACTIVE Parameter. This parameter will
 ;determine if CPRS GUI will perform the activities required for PFSS.
 ;
 ;Local Variables
 ;  DIR   - Input array varaible for ^DIR
 ;  DTOUT - Output variable for ^DIR, timeout indicator
 ;  DUOUT - Output variable for ^DIR, up arrow indicator
 ;  EC    - Error Code
 ;  PC    - Parameter Check
 ;  PFSS  - Output variable for $$GET^XPAR, 
 ;          Current value of PFSS parameter
 ;          1 for active
 ;          0 for inactive
 ;          Null for not on file
 ;  OREM  - Output variable for ^XPAR, error code and text
 ;  Y     - Output variable for ^DIR, contains processed value of user
 ;          input.
 ;
 ;External references
 ;  HOME^%ZIS   DBIA 10086, User console device set up
 ;  ^DIR        DBIA 10026, FileMan user input reader
 ;  $$GET^XPAR  DBIA 2263, Get current value of parameter
 ;  ADD^XPAR    DBIA 2263, Add new parameter
 ;  GET^XPAR    DBIA 2263, Change current value of parameter
 ;
EN ;Routine entry point
 N DIR,DTOUT,DUOUT,EC,PC,PFSS,OREM,Y
 D:'$D(IO)!('$D(IOF)) HOME^%ZIS
 W @IOF,$P($T(SH),";",3)
 ; SUGGEST REPLACING PATCH CHECK WITH +$$SWSTAT^IBBAPI() CHECK
 ;Check for required patch, if missing alert user and quit
 ;Next 2 lines remarked out, to be implemented with release of 215
 ;To be removed with release of 228
 ;S PC=+$$PATCH^XPDUTL("OR*3.0*228")
 ;I PC=0 S EC=1 D ERTRAP Q
 ;Get current value of ORWPFSS ACTIVE parameter
 S PFSS=$$GET^XPAR("SYS","ORWPFSS ACTIVE",1,"I")
 ;If it does not exist add and default to inactive
 ;If error occurs during parameter add, alert user and quit
 I PFSS="" D  I OREM>0 Q
 . D ADD^XPAR("SYS","ORWPFSS ACTIVE",1,0,.OREM)
 . I OREM>0 S EC=2 D ERTRAP
 S DIR(0)="Y"
 I PFSS=1 D
 . ;If active present option to set PFSS to inactive
 . ;Confirm the user's selection
 . ;If error occurs during deactivation, alert user
 . W !!,$P($T(AM0),";",3),!,$P($T(AM1),";",3)
 . D ^DIR I Y=0!($D(DTOUT))!($D(DUOUT)) Q
 . W !!,$P($T(AM2),";",3)
 . D ^DIR I Y=0!($D(DTOUT))!($D(DUOUT)) Q
 . D CHG^XPAR("SYS","ORWPFSS ACTIVE",1,0,.OREM)
 . I OREM>0 S EC=4 D ERTRAP Q
 . W !!,$P($T(AM3),";",3)
 . S DIR(0)="E" D ^DIR
 E  D
 . ;If inactive present option to set active
 . ;Confirm the user's selection
 . ;If errors occurs during activation, alert user
 . W !!,$P($T(IM0),";",3),!,$P($T(IM1),";",3)
 . D ^DIR I Y=0!($D(DTOUT))!($D(DUOUT)) Q
 . W !!,$P($T(IM2),";",3)
 . D ^DIR I Y=0!($D(DTOUT))!($D(DUOUT)) Q
 . D CHG^XPAR("SYS","ORWPFSS ACTIVE",1,1,.OREM)
 . I OREM>0 S EC=3 D ERTRAP Q
 . W !!,$P($T(IM3),";",3)
 . S DIR(0)="E" D ^DIR
 Q
 ;
ERTRAP ;Error Trap, processes various errors and alerts the user
 I EC=1 W !!,$P($T(EM1),";",3),!,$P($T(EM2),";",3)
 I EC=2 W !!,$P($T(EM3),";",3)
 I EC=3 W !!,$P($T(EM4),";",3)
 I EC=4 W !!,$P($T(EM5),";",3)
 S DIR(0)="E"
 I EC>1 W !!,$P($T(EM6),";",3)," ",$P(OREM,U)," ",$P($T(EM7),";",3)," ",$P(OREM,U,2)
 W !!,$P($T(EM8),";",3)
 D ^DIR
 Q
 ;
 ;USER INTERFACE TEXT
EM1 ;;Required patch OR*3.0*228 is not installed. It must be installed
EM2 ;;before this option can be run.
EM3 ;;Error adding parameter ORWPFSS ACTIVE
EM4 ;;Error activating parameter ORWPFSS ACTIVE
EM5 ;;Error deactivating parameter ORWPFSS ACTIVE
EM6 ;;Error code:
EM7 ;;Error Description:
EM8 ;;Please report this problem to your support staff.
SH ;;CPRS - Activate/Deactivate PFSS
IM0 ;;PFSS for CPRS is >> INACTIVE <<
IM1 ;;Do you want to activate PFSS for CPRS?
IM2 ;;Are you sure you want to activate PFSS for CPRS?
IM3 ;;PFSS is now active for CPRS.
AM0 ;;PFSS for CPRS is >> ACTIVE <<
AM1 ;;Do you want to deactivate PFSS for CPRS?
AM2 ;;Are you sure you want to deactivate PFSS for CPRS?
AM3 ;;PFSS is now inactive for CPRS.
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORWPFSS0   3929     printed  Sep 23, 2025@20:13:23                                                                                                                                                                                                    Page 2
ORWPFSS0  ;SCL/GDU - CPRS PFSS Parameter Maintainance;[02/24/05 13:13] ;2/28/05  09:51
 +1       ;;3.0;ORDER ENTRY/RESULTS REPORTING;**215**;Dec 17, 1997
 +2       ;Routine to maintain the ORWPFSS ACTIVE Parameter. This parameter will
 +3       ;determine if CPRS GUI will perform the activities required for PFSS.
 +4       ;
 +5       ;Local Variables
 +6       ;  DIR   - Input array varaible for ^DIR
 +7       ;  DTOUT - Output variable for ^DIR, timeout indicator
 +8       ;  DUOUT - Output variable for ^DIR, up arrow indicator
 +9       ;  EC    - Error Code
 +10      ;  PC    - Parameter Check
 +11      ;  PFSS  - Output variable for $$GET^XPAR, 
 +12      ;          Current value of PFSS parameter
 +13      ;          1 for active
 +14      ;          0 for inactive
 +15      ;          Null for not on file
 +16      ;  OREM  - Output variable for ^XPAR, error code and text
 +17      ;  Y     - Output variable for ^DIR, contains processed value of user
 +18      ;          input.
 +19      ;
 +20      ;External references
 +21      ;  HOME^%ZIS   DBIA 10086, User console device set up
 +22      ;  ^DIR        DBIA 10026, FileMan user input reader
 +23      ;  $$GET^XPAR  DBIA 2263, Get current value of parameter
 +24      ;  ADD^XPAR    DBIA 2263, Add new parameter
 +25      ;  GET^XPAR    DBIA 2263, Change current value of parameter
 +26      ;
EN        ;Routine entry point
 +1        NEW DIR,DTOUT,DUOUT,EC,PC,PFSS,OREM,Y
 +2        if '$DATA(IO)!('$DATA(IOF))
               DO HOME^%ZIS
 +3        WRITE @IOF,$PIECE($TEXT(SH),";",3)
 +4       ; SUGGEST REPLACING PATCH CHECK WITH +$$SWSTAT^IBBAPI() CHECK
 +5       ;Check for required patch, if missing alert user and quit
 +6       ;Next 2 lines remarked out, to be implemented with release of 215
 +7       ;To be removed with release of 228
 +8       ;S PC=+$$PATCH^XPDUTL("OR*3.0*228")
 +9       ;I PC=0 S EC=1 D ERTRAP Q
 +10      ;Get current value of ORWPFSS ACTIVE parameter
 +11       SET PFSS=$$GET^XPAR("SYS","ORWPFSS ACTIVE",1,"I")
 +12      ;If it does not exist add and default to inactive
 +13      ;If error occurs during parameter add, alert user and quit
 +14       IF PFSS=""
               Begin DoDot:1
 +15               DO ADD^XPAR("SYS","ORWPFSS ACTIVE",1,0,.OREM)
 +16               IF OREM>0
                       SET EC=2
                       DO ERTRAP
               End DoDot:1
               IF OREM>0
                   QUIT 
 +17       SET DIR(0)="Y"
 +18       IF PFSS=1
               Begin DoDot:1
 +19      ;If active present option to set PFSS to inactive
 +20      ;Confirm the user's selection
 +21      ;If error occurs during deactivation, alert user
 +22               WRITE !!,$PIECE($TEXT(AM0),";",3),!,$PIECE($TEXT(AM1),";",3)
 +23               DO ^DIR
                   IF Y=0!($DATA(DTOUT))!($DATA(DUOUT))
                       QUIT 
 +24               WRITE !!,$PIECE($TEXT(AM2),";",3)
 +25               DO ^DIR
                   IF Y=0!($DATA(DTOUT))!($DATA(DUOUT))
                       QUIT 
 +26               DO CHG^XPAR("SYS","ORWPFSS ACTIVE",1,0,.OREM)
 +27               IF OREM>0
                       SET EC=4
                       DO ERTRAP
                       QUIT 
 +28               WRITE !!,$PIECE($TEXT(AM3),";",3)
 +29               SET DIR(0)="E"
                   DO ^DIR
               End DoDot:1
 +30      IF '$TEST
               Begin DoDot:1
 +31      ;If inactive present option to set active
 +32      ;Confirm the user's selection
 +33      ;If errors occurs during activation, alert user
 +34               WRITE !!,$PIECE($TEXT(IM0),";",3),!,$PIECE($TEXT(IM1),";",3)
 +35               DO ^DIR
                   IF Y=0!($DATA(DTOUT))!($DATA(DUOUT))
                       QUIT 
 +36               WRITE !!,$PIECE($TEXT(IM2),";",3)
 +37               DO ^DIR
                   IF Y=0!($DATA(DTOUT))!($DATA(DUOUT))
                       QUIT 
 +38               DO CHG^XPAR("SYS","ORWPFSS ACTIVE",1,1,.OREM)
 +39               IF OREM>0
                       SET EC=3
                       DO ERTRAP
                       QUIT 
 +40               WRITE !!,$PIECE($TEXT(IM3),";",3)
 +41               SET DIR(0)="E"
                   DO ^DIR
               End DoDot:1
 +42       QUIT 
 +43      ;
ERTRAP    ;Error Trap, processes various errors and alerts the user
 +1        IF EC=1
               WRITE !!,$PIECE($TEXT(EM1),";",3),!,$PIECE($TEXT(EM2),";",3)
 +2        IF EC=2
               WRITE !!,$PIECE($TEXT(EM3),";",3)
 +3        IF EC=3
               WRITE !!,$PIECE($TEXT(EM4),";",3)
 +4        IF EC=4
               WRITE !!,$PIECE($TEXT(EM5),";",3)
 +5        SET DIR(0)="E"
 +6        IF EC>1
               WRITE !!,$PIECE($TEXT(EM6),";",3)," ",$PIECE(OREM,U)," ",$PIECE($TEXT(EM7),";",3)," ",$PIECE(OREM,U,2)
 +7        WRITE !!,$PIECE($TEXT(EM8),";",3)
 +8        DO ^DIR
 +9        QUIT 
 +10      ;
 +11      ;USER INTERFACE TEXT
EM1       ;;Required patch OR*3.0*228 is not installed. It must be installed
EM2       ;;before this option can be run.
EM3       ;;Error adding parameter ORWPFSS ACTIVE
EM4       ;;Error activating parameter ORWPFSS ACTIVE
EM5       ;;Error deactivating parameter ORWPFSS ACTIVE
EM6       ;;Error code:
EM7       ;;Error Description:
EM8       ;;Please report this problem to your support staff.
SH        ;;CPRS - Activate/Deactivate PFSS
IM0       ;;PFSS for CPRS is >> INACTIVE <<
IM1       ;;Do you want to activate PFSS for CPRS?
IM2       ;;Are you sure you want to activate PFSS for CPRS?
IM3       ;;PFSS is now active for CPRS.
AM0       ;;PFSS for CPRS is >> ACTIVE <<
AM1       ;;Do you want to deactivate PFSS for CPRS?
AM2       ;;Are you sure you want to deactivate PFSS for CPRS?
AM3       ;;PFSS is now inactive for CPRS.