AMQQTXC1 ; IHS/CMI/THL - OHPRD/DG/MAINTAIN CODE RANGES IN TABLE ; 17 Mar 2014 2:26 PM
;;2.0;IHS PCC SUITE;**11**;MAY 14, 2009;Build 58
;-----
I 'AMQQSUB D ADD I 1
E D DEL
D EOJ
Q
;
ADD ; SECTION FOR ADDING CODES TO TABLE
I '$D(@AMQQHILO) S @AMQQHILO@(AMQQ("LOW"))=AMQQ("HI")_U_$G(AMQQISYS) G X1
S AMQQDONE=0
S AMQQVAL=""
F S AMQQVAL=$O(@AMQQHILO@(AMQQVAL)) Q:AMQQVAL="" I $P(@AMQQHILO@(AMQQVAL),U,2)=$G(AMQQISYS) D GETCASE,ADDPROC Q:AMQQDONE
D:'AMQQDONE SETRANGE
K AMQQDONE,AMQQVAL,AMQQCASE
X1 Q
;
ADDPROC ; CASE SPECIFIC ADD PROCESSING
G @("ADD"_AMQQCASE)
ADD2 ;;
ADD3 ;;
ADD4 ;;
S @AMQQHILO@(AMQQ("LOW"))=@AMQQHILO@(AMQQVAL)
K @AMQQHILO@(AMQQVAL)
ADD6 ;;
ADD7 ;;
ADD9 ;;
ADD10 ;;
S AMQQDONE=1
Q
ADD11 ;;
ADD12 ;;
S AMQQ("LOW")=AMQQVAL
ADD5 ;;
ADD8 ;;
K @AMQQHILO@(AMQQVAL)
ADD1 ;;
ADD13 ;;
; continue
Q
;
SETRANGE ;
I '$D(AMQQCASE) S @AMQQHILO@(AMQQ("LOW"))=AMQQ("HI")_U_$G(AMQQISYS) Q
G @("SET"_AMQQCASE)
SET5 ;;
SET8 ;;
SET11 ;;
SET12 ;;
S @AMQQHILO@(AMQQ("LOW"))=AMQQ("HI")_U_$G(AMQQISYS)
Q
;
SET1 ;;
S AMQQVAL=""
S AMQQNEXT=$O(@AMQQTGBL@("BA",AMQQ("HI")))
F S AMQQVAL=$O(@AMQQHILO@(AMQQVAL)) Q:AMQQVAL=""!(AMQQVAL=AMQQNEXT)
I AMQQVAL="" S @AMQQHILO@(AMQQ("LOW"))=AMQQ("HI")_U_$G(AMQQISYS)
E S @AMQQHILO@(AMQQ("LOW"))=@AMQQHILO@(AMQQVAL) K @AMQQHILO@(AMQQVAL)
Q
;
SET13 ;;
S AMQQVAL=""
F S AMQQVAL=$O(@AMQQHILO@(AMQQVAL)) Q:AMQQVAL="" Q:AMQQ("LOW")=$O(@AMQQTGBL@("BA",$P(@AMQQHILO@(AMQQVAL),U,1)))
I AMQQVAL="" S @AMQQHILO@(AMQQ("LOW"))=AMQQ("HI")_U_$G(AMQQISYS)
E S @AMQQHILO@(AMQQVAL)=AMQQ("HI")_U_$G(AMQQISYS)
Q
;
DEL ; SECTION FOR DELETING CODES FROM TABLE
I '$D(@AMQQHILO) G X2
S AMQQDONE=0
S AMQQVAL=""
F S AMQQVAL=$O(@AMQQHILO@(AMQQVAL)) Q:AMQQVAL="" I $P(@AMQQHILO@(AMQQVAL),U,2)=$G(AMQQISYS) D GETCASE,DELPROC Q:AMQQDONE
X2 Q
;
DELPROC ;CASE SPECIFIC DEL PROCESSING
G @("DEL"_AMQQCASE)
DEL2 ;;
I AMQQ("HI")=$P(@AMQQHILO@(AMQQVAL),U,1) K @AMQQHILO@(AMQQVAL)
E S @AMQQHILO@($O(@AMQQTGBL@("BA",AMQQ("HI"))))=@AMQQHILO@(AMQQVAL) K @AMQQHILO@(AMQQVAL)
S AMQQDONE=1
Q
;
DEL3 ;;
DEL6 ;;
S @AMQQHILO@($O(@AMQQTGBL@("BA",AMQQ("HI"))))=@AMQQHILO@(AMQQVAL) K @AMQQHILO@(AMQQVAL)
S AMQQDONE=1
Q
;
DEL4 ;;
DEL5 ;;
DEL7 ;;
DEL8 ;;
K @AMQQHILO@(AMQQVAL)
I AMQQCASE'=8,AMQQCASE'=5 S AMQQDONE=1
Q
;
DEL10 ;;
DEL11 ;;
DEL12 ;;
D @$S($E(@AMQQHILO@(AMQQVAL))?1N:"NUMBER",1:"LETTER")
S @AMQQHILO@(AMQQVAL)=AMQQ("NEWHI")_U_$G(AMQQISYS)
I AMQQCASE=10 S AMQQDONE=1
Q
;
DEL9 ;;
D @$S($E(@AMQQHILO@(AMQQVAL))?1N:"NUMBER",1:"LETTER")
S @AMQQHILO@($O(@AMQQTGBL@("BA",AMQQ("HI"))))=$P(@AMQQHILO@(AMQQVAL),U,1)
S @AMQQHILO@(AMQQVAL)=AMQQ("NEWHI")_U_$G(AMQQISYS)
S AMQQDONE=1
Q
;
DEL1 ;;
DEL13 ;;
Q
;
GETCASE ; SUBROUTINE TO DETERMINE AMQQCASE # FROM INPUT CODE RANGE
S AMQQ("TLOW")=AMQQVAL
S AMQQ("THI")=$P(@AMQQHILO@(AMQQVAL),U,1)
D CASEA:AMQQ("TLOW")]AMQQ("LOW")
D CASEB:AMQQ("LOW")=AMQQ("TLOW")
D CASEC:AMQQ("LOW")]AMQQ("TLOW")
K AMQQ("TLOW"),AMQQ("THI")
Q
;
CASEA ;
I AMQQ("HI")]AMQQ("TLOW") S AMQQCASE=$S(AMQQ("THI")]AMQQ("HI"):3,AMQQ("HI")=AMQQ("THI"):4,1:5)
E S AMQQCASE=$S(AMQQ("TLOW")]AMQQ("HI"):1,1:2)
Q
;
CASEB ;
S AMQQCASE=$S(AMQQ("THI")]AMQQ("HI"):6,AMQQ("HI")=AMQQ("THI"):7,1:8)
Q
;
CASEC ;
I AMQQ("THI")]AMQQ("LOW") S AMQQCASE=$S(AMQQ("THI")]AMQQ("HI"):9,AMQQ("HI")=AMQQ("THI"):10,1:11)
E S AMQQCASE=$S(AMQQ("LOW")=AMQQ("THI"):12,1:13)
Q
;
NUMBER ;
S AMQQ("CODE")=+AMQQ("LOW")-5
F Q:AMQQ("LOW")]AMQQ("CODE") S AMQQ("CODE")=+$O(@AMQQTGBL@("BA",AMQQ("CODE")_" "))
S AMQQ("CODE")=AMQQ("CODE")_" "
F S AMQQ("NEWHI")=AMQQ("CODE"),AMQQ("CODE")=$O(@AMQQTGBL@("BA",AMQQ("CODE"))) Q:AMQQ("CODE")=AMQQ("LOW")
Q
;
LETTER ;
S AMQQ("LET")=$E(AMQQ("LOW"))_" "
F S AMQQ("NEWHI")=AMQQ("LET"),AMQQ("LET")=$O(@AMQQTGBL@("BA",AMQQ("LET"))) Q:AMQQ("LET")=AMQQ("LOW")
Q
EOJ ;
K AMQQCASE,AMQQDONE,AMQQNEXT,AMQQONE,AMQQVAL
Q
;
AMQQTXC1 ; IHS/CMI/THL - OHPRD/DG/MAINTAIN CODE RANGES IN TABLE ; 17 Mar 2014 2:26 PM
+1 ;;2.0;IHS PCC SUITE;**11**;MAY 14, 2009;Build 58
+2 ;-----
+3 IF 'AMQQSUB
DO ADD
IF 1
+4 IF '$TEST
DO DEL
+5 DO EOJ
+6 QUIT
+7 ;
ADD ; SECTION FOR ADDING CODES TO TABLE
+1 IF '$DATA(@AMQQHILO)
SET @AMQQHILO@(AMQQ("LOW"))=AMQQ("HI")_U_$GET(AMQQISYS)
GOTO X1
+2 SET AMQQDONE=0
+3 SET AMQQVAL=""
+4 FOR
SET AMQQVAL=$ORDER(@AMQQHILO@(AMQQVAL))
IF AMQQVAL=""
QUIT
IF $PIECE(@AMQQHILO@(AMQQVAL),U,2)=$GET(AMQQISYS)
DO GETCASE
DO ADDPROC
IF AMQQDONE
QUIT
+5 IF 'AMQQDONE
DO SETRANGE
+6 KILL AMQQDONE,AMQQVAL,AMQQCASE
X1 QUIT
+1 ;
ADDPROC ; CASE SPECIFIC ADD PROCESSING
+1 GOTO @("ADD"_AMQQCASE)
ADD2 ;;
ADD3 ;;
ADD4 ;;
+1 SET @AMQQHILO@(AMQQ("LOW"))=@AMQQHILO@(AMQQVAL)
+2 KILL @AMQQHILO@(AMQQVAL)
ADD6 ;;
ADD7 ;;
ADD9 ;;
ADD10 ;;
+1 SET AMQQDONE=1
+2 QUIT
ADD11 ;;
ADD12 ;;
+1 SET AMQQ("LOW")=AMQQVAL
ADD5 ;;
ADD8 ;;
+1 KILL @AMQQHILO@(AMQQVAL)
ADD1 ;;
ADD13 ;;
+1 ; continue
+2 QUIT
+3 ;
SETRANGE ;
+1 IF '$DATA(AMQQCASE)
SET @AMQQHILO@(AMQQ("LOW"))=AMQQ("HI")_U_$GET(AMQQISYS)
QUIT
+2 GOTO @("SET"_AMQQCASE)
SET5 ;;
SET8 ;;
SET11 ;;
SET12 ;;
+1 SET @AMQQHILO@(AMQQ("LOW"))=AMQQ("HI")_U_$GET(AMQQISYS)
+2 QUIT
+3 ;
SET1 ;;
+1 SET AMQQVAL=""
+2 SET AMQQNEXT=$ORDER(@AMQQTGBL@("BA",AMQQ("HI")))
+3 FOR
SET AMQQVAL=$ORDER(@AMQQHILO@(AMQQVAL))
IF AMQQVAL=""!(AMQQVAL=AMQQNEXT)
QUIT
+4 IF AMQQVAL=""
SET @AMQQHILO@(AMQQ("LOW"))=AMQQ("HI")_U_$GET(AMQQISYS)
+5 IF '$TEST
SET @AMQQHILO@(AMQQ("LOW"))=@AMQQHILO@(AMQQVAL)
KILL @AMQQHILO@(AMQQVAL)
+6 QUIT
+7 ;
SET13 ;;
+1 SET AMQQVAL=""
+2 FOR
SET AMQQVAL=$ORDER(@AMQQHILO@(AMQQVAL))
IF AMQQVAL=""
QUIT
IF AMQQ("LOW")=$ORDER(@AMQQTGBL@("BA",$PIECE(@AMQQHILO@(AMQQVAL),U,1)))
QUIT
+3 IF AMQQVAL=""
SET @AMQQHILO@(AMQQ("LOW"))=AMQQ("HI")_U_$GET(AMQQISYS)
+4 IF '$TEST
SET @AMQQHILO@(AMQQVAL)=AMQQ("HI")_U_$GET(AMQQISYS)
+5 QUIT
+6 ;
DEL ; SECTION FOR DELETING CODES FROM TABLE
+1 IF '$DATA(@AMQQHILO)
GOTO X2
+2 SET AMQQDONE=0
+3 SET AMQQVAL=""
+4 FOR
SET AMQQVAL=$ORDER(@AMQQHILO@(AMQQVAL))
IF AMQQVAL=""
QUIT
IF $PIECE(@AMQQHILO@(AMQQVAL),U,2)=$GET(AMQQISYS)
DO GETCASE
DO DELPROC
IF AMQQDONE
QUIT
X2 QUIT
+1 ;
DELPROC ;CASE SPECIFIC DEL PROCESSING
+1 GOTO @("DEL"_AMQQCASE)
DEL2 ;;
+1 IF AMQQ("HI")=$PIECE(@AMQQHILO@(AMQQVAL),U,1)
KILL @AMQQHILO@(AMQQVAL)
+2 IF '$TEST
SET @AMQQHILO@($ORDER(@AMQQTGBL@("BA",AMQQ("HI"))))=@AMQQHILO@(AMQQVAL)
KILL @AMQQHILO@(AMQQVAL)
+3 SET AMQQDONE=1
+4 QUIT
+5 ;
DEL3 ;;
DEL6 ;;
+1 SET @AMQQHILO@($ORDER(@AMQQTGBL@("BA",AMQQ("HI"))))=@AMQQHILO@(AMQQVAL)
KILL @AMQQHILO@(AMQQVAL)
+2 SET AMQQDONE=1
+3 QUIT
+4 ;
DEL4 ;;
DEL5 ;;
DEL7 ;;
DEL8 ;;
+1 KILL @AMQQHILO@(AMQQVAL)
+2 IF AMQQCASE'=8
IF AMQQCASE'=5
SET AMQQDONE=1
+3 QUIT
+4 ;
DEL10 ;;
DEL11 ;;
DEL12 ;;
+1 DO @$SELECT($EXTRACT(@AMQQHILO@(AMQQVAL))?1N:"NUMBER",1:"LETTER")
+2 SET @AMQQHILO@(AMQQVAL)=AMQQ("NEWHI")_U_$GET(AMQQISYS)
+3 IF AMQQCASE=10
SET AMQQDONE=1
+4 QUIT
+5 ;
DEL9 ;;
+1 DO @$SELECT($EXTRACT(@AMQQHILO@(AMQQVAL))?1N:"NUMBER",1:"LETTER")
+2 SET @AMQQHILO@($ORDER(@AMQQTGBL@("BA",AMQQ("HI"))))=$PIECE(@AMQQHILO@(AMQQVAL),U,1)
+3 SET @AMQQHILO@(AMQQVAL)=AMQQ("NEWHI")_U_$GET(AMQQISYS)
+4 SET AMQQDONE=1
+5 QUIT
+6 ;
DEL1 ;;
DEL13 ;;
+1 QUIT
+2 ;
GETCASE ; SUBROUTINE TO DETERMINE AMQQCASE # FROM INPUT CODE RANGE
+1 SET AMQQ("TLOW")=AMQQVAL
+2 SET AMQQ("THI")=$PIECE(@AMQQHILO@(AMQQVAL),U,1)
+3 IF AMQQ("TLOW")]AMQQ("LOW")
DO CASEA
+4 IF AMQQ("LOW")=AMQQ("TLOW")
DO CASEB
+5 IF AMQQ("LOW")]AMQQ("TLOW")
DO CASEC
+6 KILL AMQQ("TLOW"),AMQQ("THI")
+7 QUIT
+8 ;
CASEA ;
+1 IF AMQQ("HI")]AMQQ("TLOW")
SET AMQQCASE=$SELECT(AMQQ("THI")]AMQQ("HI"):3,AMQQ("HI")=AMQQ("THI"):4,1:5)
+2 IF '$TEST
SET AMQQCASE=$SELECT(AMQQ("TLOW")]AMQQ("HI"):1,1:2)
+3 QUIT
+4 ;
CASEB ;
+1 SET AMQQCASE=$SELECT(AMQQ("THI")]AMQQ("HI"):6,AMQQ("HI")=AMQQ("THI"):7,1:8)
+2 QUIT
+3 ;
CASEC ;
+1 IF AMQQ("THI")]AMQQ("LOW")
SET AMQQCASE=$SELECT(AMQQ("THI")]AMQQ("HI"):9,AMQQ("HI")=AMQQ("THI"):10,1:11)
+2 IF '$TEST
SET AMQQCASE=$SELECT(AMQQ("LOW")=AMQQ("THI"):12,1:13)
+3 QUIT
+4 ;
NUMBER ;
+1 SET AMQQ("CODE")=+AMQQ("LOW")-5
+2 FOR
IF AMQQ("LOW")]AMQQ("CODE")
QUIT
SET AMQQ("CODE")=+$ORDER(@AMQQTGBL@("BA",AMQQ("CODE")_" "))
+3 SET AMQQ("CODE")=AMQQ("CODE")_" "
+4 FOR
SET AMQQ("NEWHI")=AMQQ("CODE")
SET AMQQ("CODE")=$ORDER(@AMQQTGBL@("BA",AMQQ("CODE")))
IF AMQQ("CODE")=AMQQ("LOW")
QUIT
+5 QUIT
+6 ;
LETTER ;
+1 SET AMQQ("LET")=$EXTRACT(AMQQ("LOW"))_" "
+2 FOR
SET AMQQ("NEWHI")=AMQQ("LET")
SET AMQQ("LET")=$ORDER(@AMQQTGBL@("BA",AMQQ("LET")))
IF AMQQ("LET")=AMQQ("LOW")
QUIT
+3 QUIT
EOJ ;
+1 KILL AMQQCASE,AMQQDONE,AMQQNEXT,AMQQONE,AMQQVAL
+2 QUIT
+3 ;
