SDSCP.m

SDSCP ;ALB/MLI - STOP CODE PRINT ROUTINE ; 2 NOV 87 14:00

 ;;5.3;Scheduling;**14,34,132,1001,1015**;Aug 13, 1993;Build 21

 ;

CL ; -- called from CL^SDCWL

 W ! S DIC="^DIC(40.7,",DIC(0)="EFQZM" D ^DIC K DIC("S") Q:X["?"  I Y'>0 W *7," No such stop code" Q

 I $P(Y(0),U,2)=900 W *7," is not a stop code??" Q

 I $D(SDCL($P(Y(0),"^",2))) W *7,"??    This stop code has already been selected" Q

 ;IHS/ITSC/WAR 5/3/2004 P #1001 REM'd next line - IHS does not use 3 digit codes

 ;I $P(Y(0),"^",2)'?3N W *7,"??   Must be a three digit stop code" Q

 S SDCL($P(Y(0),"^",2))=+Y,SDI=SDI+1

 Q

 ;

SDSCP     ;ALB/MLI - STOP CODE PRINT ROUTINE ; 2 NOV 87 14:00

 +1       ;;5.3;Scheduling;**14,34,132,1001,1015**;Aug 13, 1993;Build 21

 +2       ;

CL        ; -- called from CL^SDCWL

 +1        WRITE !

           SET DIC="^DIC(40.7,"

           SET DIC(0)="EFQZM"

           DO ^DIC

           KILL DIC("S")

           IF X["?"

               QUIT 

           IF Y'>0

               WRITE *7," No such stop code"

               QUIT 

 +2        IF $PIECE(Y(0),U,2)=900

               WRITE *7," is not a stop code??"

               QUIT 

 +3        IF $DATA(SDCL($PIECE(Y(0),"^",2)))

               WRITE *7,"??    This stop code has already been selected"

               QUIT 

 +4       ;IHS/ITSC/WAR 5/3/2004 P #1001 REM'd next line - IHS does not use 3 digit codes

 +5       ;I $P(Y(0),"^",2)'?3N W *7,"??   Must be a three digit stop code" Q

 +6        SET SDCL($PIECE(Y(0),"^",2))=+Y

           SET SDI=SDI+1

 +7        QUIT 

 +8       ;