PSX41PRE ;BHAM/PDW-ENVIRONMENTAL PRE CHECK ;10/17/2002
 ;;2.0;CMOP;**41**;11 Apr 97
EN ;
 I ^XMB("NETNAME")?1"CMOP-".E Q
 I '$$PATCH^XPDUTL("PSO*7.0*126") S XPDQUIT=1 W !,"PSO*7.0*126 is required to be installed" H 5 Q
 D SET I $G(PSXER) S XPDQUIT=1
 I PSXSYS,$P(^PSX(550,+PSXSYS,0),"^",3)'="H" W !,"A transmission is in progress,try later." S XPDQUIT=1
 I $D(^PSX(550,"AT")) W !!,"NON-CS Auto transmissions are scheduled. Please unschedule all transmissions." S XPDQUIT=1
 I $D(^PSX(550,"ATC")) W !!,"CS Auto transmissions are scheduled. Please unschedule all transmissions." S XPDQUIT=1
 ;
 I $D(^PSX(550.2,"AQ")) W !!,"The CMOP TRANSMISSION file #550.2 has entries that have a 'CREATED' status.",!,"Please consult the patch documentation on how to clear this problem." S XPDQUIT=1
 I $G(XPDQUIT) D
 . W !!!,"The above problem(s) need to be addressed and resolved prior to",!,"PSX*2*41 being able to be installed.",!!
 . K DIR S DIR(0)="E",DIR("A")="<cr> - Continue" D ^DIR K DIR
 I $$PATCH^XPDUTL("PSX*2.0*41"),$G(XPDQUIT) D
 . W !!!,"Patch PSX*2*41 has been previously installed."
 . W !!,"If PSX*2*41 HAS NOT BEEN backed out you may proceed."
 . W !!,"If PSX*2*41 HAS BEEN backed out the problems need to be fixed",!,"before it is installed again.",!!
 . K DIR S DIR(0)="Y",DIR("B")="N",DIR("A")="Do you wish to proceed with this PSX*2*41 installation " D ^DIR
 . I Y=1 K XPDQUIT
 Q
SET ; this is code from SET^PSXSYS
 S PSXSYS=0 Q:'$D(^PSX(550,"C"))
 S (S1,DA)=$$KSP^XUPARAM("INST"),DIC="4",DIQ(0)="IE",DR=".01;99"
 S DIQ="PSXUTIL" D EN^DIQ1 S S3=$G(PSXUTIL(4,S1,99,"I")),S2=$G(PSXUTIL(4,S1,.01,"E")) K DA,DIC,DIQ(0),DR
 S PSXSYS=+$O(^PSX(550,"C",""))_"^"_$G(S3)_"^"_$G(S2)
 I $G(S3)="" S PSXER=1 W !,"I can't seem to find your site # in the INSTITUTION file.  Please call the National Help Desk and report the problem."
 K S3,S2,S1,PSXUTIL
 Q
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSX41PRE   1879     printed  Sep 23, 2025@19:19:13                                                                                                                                                                                                    Page 2
PSX41PRE  ;BHAM/PDW-ENVIRONMENTAL PRE CHECK ;10/17/2002
 +1       ;;2.0;CMOP;**41**;11 Apr 97
EN        ;
 +1        IF ^XMB("NETNAME")?1"CMOP-".E
               QUIT 
 +2        IF '$$PATCH^XPDUTL("PSO*7.0*126")
               SET XPDQUIT=1
               WRITE !,"PSO*7.0*126 is required to be installed"
               HANG 5
               QUIT 
 +3        DO SET
           IF $GET(PSXER)
               SET XPDQUIT=1
 +4        IF PSXSYS
               IF $PIECE(^PSX(550,+PSXSYS,0),"^",3)'="H"
                   WRITE !,"A transmission is in progress,try later."
                   SET XPDQUIT=1
 +5        IF $DATA(^PSX(550,"AT"))
               WRITE !!,"NON-CS Auto transmissions are scheduled. Please unschedule all transmissions."
               SET XPDQUIT=1
 +6        IF $DATA(^PSX(550,"ATC"))
               WRITE !!,"CS Auto transmissions are scheduled. Please unschedule all transmissions."
               SET XPDQUIT=1
 +7       ;
 +8        IF $DATA(^PSX(550.2,"AQ"))
               WRITE !!,"The CMOP TRANSMISSION file #550.2 has entries that have a 'CREATED' status.",!,"Please consult the patch documentation on how to clear this problem."
               SET XPDQUIT=1
 +9        IF $GET(XPDQUIT)
               Begin DoDot:1
 +10               WRITE !!!,"The above problem(s) need to be addressed and resolved prior to",!,"PSX*2*41 being able to be installed.",!!
 +11               KILL DIR
                   SET DIR(0)="E"
                   SET DIR("A")="<cr> - Continue"
                   DO ^DIR
                   KILL DIR
               End DoDot:1
 +12       IF $$PATCH^XPDUTL("PSX*2.0*41")
               IF $GET(XPDQUIT)
                   Begin DoDot:1
 +13                   WRITE !!!,"Patch PSX*2*41 has been previously installed."
 +14                   WRITE !!,"If PSX*2*41 HAS NOT BEEN backed out you may proceed."
 +15                   WRITE !!,"If PSX*2*41 HAS BEEN backed out the problems need to be fixed",!,"before it is installed again.",!!
 +16                   KILL DIR
                       SET DIR(0)="Y"
                       SET DIR("B")="N"
                       SET DIR("A")="Do you wish to proceed with this PSX*2*41 installation "
                       DO ^DIR
 +17                   IF Y=1
                           KILL XPDQUIT
                   End DoDot:1
 +18       QUIT 
SET       ; this is code from SET^PSXSYS
 +1        SET PSXSYS=0
           if '$DATA(^PSX(550,"C"))
               QUIT 
 +2        SET (S1,DA)=$$KSP^XUPARAM("INST")
           SET DIC="4"
           SET DIQ(0)="IE"
           SET DR=".01;99"
 +3        SET DIQ="PSXUTIL"
           DO EN^DIQ1
           SET S3=$GET(PSXUTIL(4,S1,99,"I"))
           SET S2=$GET(PSXUTIL(4,S1,.01,"E"))
           KILL DA,DIC,DIQ(0),DR
 +4        SET PSXSYS=+$ORDER(^PSX(550,"C",""))_"^"_$GET(S3)_"^"_$GET(S2)
 +5        IF $GET(S3)=""
               SET PSXER=1
               WRITE !,"I can't seem to find your site # in the INSTITUTION file.  Please call the National Help Desk and report the problem."
 +6        KILL S3,S2,S1,PSXUTIL
 +7        QUIT