- 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 ---[H[J[2J[HPSS0114 781 printed Apr 23, 2025@18:43:04 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
