PSX41PRE.m

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 ---PSX41PRE   1879     printed  Apr 09, 2024@20:49:48                                                                                                                                                                                                    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