PSS0114.m

PSS0114 ;BIR/JLC-UPDATE ORDERABLE ITEMS WITH DEFAULT MED ROUTES ;08/28/2006

 ;;1.0;PHARMACY DATA MANAGEMENT;**114**;9/30/97;Build 2

 ;

 ;

 N A,B,C,DF,Y,MRP,MR,OUT,IEN,OK,X

EN K DIC S DIC="^PS(50.606,",DIC(0)="AEMQ",DIC("A")="Select DOSAGE FORM: " D ^DIC K DIC Q:X=""!(X="^")  I Y<0 G EN

 S DF=$P(Y,"^",2)

EN1 K DIC S DIC="^PS(51.2,",DIC(0)="AEMQ",DIC("A")="Select MEDICATION ROUTE: " D ^DIC K DIC Q:X=""!(X="^")  I Y<0 G EN1

 W ! S MRP=$P(Y,"^"),MR=$P(Y,"^",2),(OUT,IEN)=0

 F  S IEN=$O(^PS(50.7,IEN)) Q:'IEN  D  Q:OUT

 . S A=$G(^(IEN,0)) Q:$P(A,"^",6)]""  S B=$P(A,"^",2) Q:B=""  S C=$P($G(^PS(50.606,B,0)),"^")

 . Q:C'=DF

 . W !,IEN," ",$P(A,"^")," ok to change? " R OK:60 W "  " I OK="^" S OUT=1 Q

 . I OK'="Y" Q

 . S $P(^PS(50.7,IEN,0),"^",6)=MRP

 Q

EXIT     Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PSS0114   781     printed  Apr 09, 2024@21:35:17                                                                                                                                                                                                      Page 2

PSS0114   ;BIR/JLC-UPDATE ORDERABLE ITEMS WITH DEFAULT MED ROUTES ;08/28/2006

 +1       ;;1.0;PHARMACY DATA MANAGEMENT;**114**;9/30/97;Build 2

 +2       ;

 +3       ;

 +4        NEW A,B,C,DF,Y,MRP,MR,OUT,IEN,OK,X

EN         KILL DIC

           SET DIC="^PS(50.606,"

           SET DIC(0)="AEMQ"

           SET DIC("A")="Select DOSAGE FORM: "

           DO ^DIC

           KILL DIC

           if X=""!(X="^")

               QUIT 

           IF Y<0

               GOTO EN

 +1        SET DF=$PIECE(Y,"^",2)

EN1        KILL DIC

           SET DIC="^PS(51.2,"

           SET DIC(0)="AEMQ"

           SET DIC("A")="Select MEDICATION ROUTE: "

           DO ^DIC

           KILL DIC

           if X=""!(X="^")

               QUIT 

           IF Y<0

               GOTO EN1

 +1        WRITE !

           SET MRP=$PIECE(Y,"^")

           SET MR=$PIECE(Y,"^",2)

           SET (OUT,IEN)=0

 +2        FOR 

               SET IEN=$ORDER(^PS(50.7,IEN))

               if 'IEN

                   QUIT 

               Begin DoDot:1

 +3                SET A=$GET(^(IEN,0))

                   if $PIECE(A,"^",6)]""

                       QUIT 

                   SET B=$PIECE(A,"^",2)

                   if B=""

                       QUIT 

                   SET C=$PIECE($GET(^PS(50.606,B,0)),"^")

 +4                if C'=DF

                       QUIT 

 +5                WRITE !,IEN," ",$PIECE(A,"^")," ok to change? "

                   READ OK:60

                   WRITE "  "

                   IF OK="^"

                       SET OUT=1

                       QUIT 

 +6                IF OK'="Y"

                       QUIT 

 +7                SET $PIECE(^PS(50.7,IEN,0),"^",6)=MRP

               End DoDot:1

               if OUT

                   QUIT 

 +8        QUIT 

EXIT       QUIT