PSJIPRE.m

PSJIPRE ;BIR/CML3-PREINIT FOR INPATIENT ;20 MAR 97 / 9:41 AM

 ;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97

 ;

 ;

ENSO ;Place all Inpatient options out of service.

 D MES^XPDUTL(" ")

 S PSJMESSG=" In order to prevent the corruption of existing data while running version 5.0" D MES^XPDUTL(PSJMESSG)

 S PSJMESSG=" install, all of the Inpatient Medications options will be placed" D MES^XPDUTL(PSJMESSG)

 S PSJMESSG=" OUT OF ORDER.  They will be made available again once the version 5.0" D MES^XPDUTL(PSJMESSG)

 S PSJMESSG=" install is finished.            ....working...." D MES^XPDUTL(PSJMESSG)

 ;

 S Q1="PSJ" F  S Q1=$O(^DIC(19,"B",Q1)) Q:$E(Q1,1,3)'="PSJ"  I $E(Q1,1,4)'="PSJ4" F Q2=0:0 S Q2=$O(^DIC(19,"B",Q1,Q2)) Q:'Q2  S DIE="^DIC(19,",DA=Q2,DR="2////UNAVAILABLE UNTIL INPATIENT CONVERSIONS COMPLETE..." D ^DIE

 S Q1="PSJ" F  S Q1=$O(^ORD(101,"B",Q1)) Q:$E(Q1,1,3)'="PSJ"  I Q1'="PSJ OR PAT ADT" F Q2=0:0 S Q2=$O(^ORD(101,"B",Q1,Q2)) Q:'Q2  S DIE="^ORD(101,",DA=Q2,DR="2////UNAVAILABLE UNTIL CONVERSIONS COMPLETE" D ^DIE

 K DA,DIE,DR,PSJMESSG,Q1,Q2,X,Y

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PSJIPRE   1072     printed  Apr 09, 2024@21:06:40                                                                                                                                                                                                     Page 2

PSJIPRE   ;BIR/CML3-PREINIT FOR INPATIENT ;20 MAR 97 / 9:41 AM

 +1       ;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97

 +2       ;

 +3       ;

ENSO      ;Place all Inpatient options out of service.

 +1        DO MES^XPDUTL(" ")

 +2        SET PSJMESSG=" In order to prevent the corruption of existing data while running version 5.0"

           DO MES^XPDUTL(PSJMESSG)

 +3        SET PSJMESSG=" install, all of the Inpatient Medications options will be placed"

           DO MES^XPDUTL(PSJMESSG)

 +4        SET PSJMESSG=" OUT OF ORDER.  They will be made available again once the version 5.0"

           DO MES^XPDUTL(PSJMESSG)

 +5        SET PSJMESSG=" install is finished.            ....working...."

           DO MES^XPDUTL(PSJMESSG)

 +6       ;

 +7        SET Q1="PSJ"

           FOR 

               SET Q1=$ORDER(^DIC(19,"B",Q1))

               if $EXTRACT(Q1,1,3)'="PSJ"

                   QUIT 

               IF $EXTRACT(Q1,1,4)'="PSJ4"

                   FOR Q2=0:0

                       SET Q2=$ORDER(^DIC(19,"B",Q1,Q2))

                       if 'Q2

                           QUIT 

                       SET DIE="^DIC(19,"

                       SET DA=Q2

                       SET DR="2////UNAVAILABLE UNTIL INPATIENT CONVERSIONS COMPLETE..."

                       DO ^DIE

 +8        SET Q1="PSJ"

           FOR 

               SET Q1=$ORDER(^ORD(101,"B",Q1))

               if $EXTRACT(Q1,1,3)'="PSJ"

                   QUIT 

               IF Q1'="PSJ OR PAT ADT"

                   FOR Q2=0:0

                       SET Q2=$ORDER(^ORD(101,"B",Q1,Q2))

                       if 'Q2

                           QUIT 

                       SET DIE="^ORD(101,"

                       SET DA=Q2

                       SET DR="2////UNAVAILABLE UNTIL CONVERSIONS COMPLETE"

                       DO ^DIE

 +9        KILL DA,DIE,DR,PSJMESSG,Q1,Q2,X,Y

 +10       QUIT