Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: AMQQTXC1

AMQQTXC1.m

Go to the documentation of this file. 
  1. 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
  1.  ;-----
  1.  I 'AMQQSUB D ADD I 1
  1.  E  D DEL
  1.  D EOJ
  1.  Q
  1.  ;
  1. ADD ; SECTION FOR ADDING CODES TO TABLE
  1.  I '$D(@AMQQHILO) S @AMQQHILO@(AMQQ("LOW"))=AMQQ("HI")_U_$G(AMQQISYS) G X1
  1.  S AMQQDONE=0
  1.  S AMQQVAL=""
  1.  F  S AMQQVAL=$O(@AMQQHILO@(AMQQVAL)) Q:AMQQVAL=""  I $P(@AMQQHILO@(AMQQVAL),U,2)=$G(AMQQISYS) D GETCASE,ADDPROC Q:AMQQDONE
  1.  D:'AMQQDONE SETRANGE
  1.  K AMQQDONE,AMQQVAL,AMQQCASE
  1. X1 Q
  1.  ;
  1. ADDPROC ; CASE SPECIFIC ADD PROCESSING
  1.  G @("ADD"_AMQQCASE)
  1. ADD2 ;;
  1. ADD3 ;;
  1. ADD4 ;;
  1.  S @AMQQHILO@(AMQQ("LOW"))=@AMQQHILO@(AMQQVAL)
  1.  K @AMQQHILO@(AMQQVAL)
  1. ADD6 ;;
  1. ADD7 ;;
  1. ADD9 ;;
  1. ADD10 ;;
  1.  S AMQQDONE=1
  1.  Q
  1. ADD11 ;;
  1. ADD12 ;;
  1.  S AMQQ("LOW")=AMQQVAL
  1. ADD5 ;;
  1. ADD8 ;;
  1.  K @AMQQHILO@(AMQQVAL)
  1. ADD1 ;;
  1. ADD13 ;;
  1.  ; continue
  1.  Q
  1.  ;
  1. SETRANGE ;
  1.  I '$D(AMQQCASE) S @AMQQHILO@(AMQQ("LOW"))=AMQQ("HI")_U_$G(AMQQISYS) Q
  1.  G @("SET"_AMQQCASE)
  1. SET5 ;;
  1. SET8 ;;
  1. SET11 ;;
  1. SET12 ;;
  1.  S @AMQQHILO@(AMQQ("LOW"))=AMQQ("HI")_U_$G(AMQQISYS)
  1.  Q
  1.  ;
  1. SET1 ;;
  1.  S AMQQVAL=""
  1.  S AMQQNEXT=$O(@AMQQTGBL@("BA",AMQQ("HI")))
  1.  F  S AMQQVAL=$O(@AMQQHILO@(AMQQVAL)) Q:AMQQVAL=""!(AMQQVAL=AMQQNEXT)
  1.  I AMQQVAL="" S @AMQQHILO@(AMQQ("LOW"))=AMQQ("HI")_U_$G(AMQQISYS)
  1.  E  S @AMQQHILO@(AMQQ("LOW"))=@AMQQHILO@(AMQQVAL) K @AMQQHILO@(AMQQVAL)
  1.  Q
  1.  ;
  1. SET13 ;;
  1.  S AMQQVAL=""
  1.  F  S AMQQVAL=$O(@AMQQHILO@(AMQQVAL)) Q:AMQQVAL=""  Q:AMQQ("LOW")=$O(@AMQQTGBL@("BA",$P(@AMQQHILO@(AMQQVAL),U,1)))
  1.  I AMQQVAL="" S @AMQQHILO@(AMQQ("LOW"))=AMQQ("HI")_U_$G(AMQQISYS)
  1.  E  S @AMQQHILO@(AMQQVAL)=AMQQ("HI")_U_$G(AMQQISYS)
  1.  Q
  1.  ;
  1. DEL ; SECTION FOR DELETING CODES FROM TABLE
  1.  I '$D(@AMQQHILO) G X2
  1.  S AMQQDONE=0
  1.  S AMQQVAL=""
  1.  F  S AMQQVAL=$O(@AMQQHILO@(AMQQVAL)) Q:AMQQVAL=""  I $P(@AMQQHILO@(AMQQVAL),U,2)=$G(AMQQISYS) D GETCASE,DELPROC Q:AMQQDONE
  1. X2 Q
  1.  ;
  1. DELPROC ;CASE SPECIFIC DEL PROCESSING
  1.  G @("DEL"_AMQQCASE)
  1. DEL2 ;;
  1.  I AMQQ("HI")=$P(@AMQQHILO@(AMQQVAL),U,1) K @AMQQHILO@(AMQQVAL)
  1.  E  S @AMQQHILO@($O(@AMQQTGBL@("BA",AMQQ("HI"))))=@AMQQHILO@(AMQQVAL) K @AMQQHILO@(AMQQVAL)
  1.  S AMQQDONE=1
  1.  Q
  1.  ;
  1. DEL3 ;;
  1. DEL6 ;;
  1.  S @AMQQHILO@($O(@AMQQTGBL@("BA",AMQQ("HI"))))=@AMQQHILO@(AMQQVAL) K @AMQQHILO@(AMQQVAL)
  1.  S AMQQDONE=1
  1.  Q
  1.  ;
  1. DEL4 ;;
  1. DEL5 ;;
  1. DEL7 ;;
  1. DEL8 ;;
  1.  K @AMQQHILO@(AMQQVAL)
  1.  I AMQQCASE'=8,AMQQCASE'=5 S AMQQDONE=1
  1.  Q
  1.  ;
  1. DEL10 ;;
  1. DEL11 ;;
  1. DEL12 ;;
  1.  D @$S($E(@AMQQHILO@(AMQQVAL))?1N:"NUMBER",1:"LETTER")
  1.  S @AMQQHILO@(AMQQVAL)=AMQQ("NEWHI")_U_$G(AMQQISYS)
  1.  I AMQQCASE=10 S AMQQDONE=1
  1.  Q
  1.  ;
  1. DEL9 ;;
  1.  D @$S($E(@AMQQHILO@(AMQQVAL))?1N:"NUMBER",1:"LETTER")
  1.  S @AMQQHILO@($O(@AMQQTGBL@("BA",AMQQ("HI"))))=$P(@AMQQHILO@(AMQQVAL),U,1)
  1.  S @AMQQHILO@(AMQQVAL)=AMQQ("NEWHI")_U_$G(AMQQISYS)
  1.  S AMQQDONE=1
  1.  Q
  1.  ;
  1. DEL1 ;;
  1. DEL13 ;;
  1.  Q
  1.  ;
  1. GETCASE ; SUBROUTINE TO DETERMINE AMQQCASE # FROM INPUT CODE RANGE
  1.  S AMQQ("TLOW")=AMQQVAL
  1.  S AMQQ("THI")=$P(@AMQQHILO@(AMQQVAL),U,1)
  1.  D CASEA:AMQQ("TLOW")]AMQQ("LOW")
  1.  D CASEB:AMQQ("LOW")=AMQQ("TLOW")
  1.  D CASEC:AMQQ("LOW")]AMQQ("TLOW")
  1.  K AMQQ("TLOW"),AMQQ("THI")
  1.  Q
  1.  ;
  1. CASEA ;
  1.  I AMQQ("HI")]AMQQ("TLOW") S AMQQCASE=$S(AMQQ("THI")]AMQQ("HI"):3,AMQQ("HI")=AMQQ("THI"):4,1:5)
  1.  E  S AMQQCASE=$S(AMQQ("TLOW")]AMQQ("HI"):1,1:2)
  1.  Q
  1.  ;
  1. CASEB ;
  1.  S AMQQCASE=$S(AMQQ("THI")]AMQQ("HI"):6,AMQQ("HI")=AMQQ("THI"):7,1:8)
  1.  Q
  1.  ;
  1. CASEC ;
  1.  I AMQQ("THI")]AMQQ("LOW") S AMQQCASE=$S(AMQQ("THI")]AMQQ("HI"):9,AMQQ("HI")=AMQQ("THI"):10,1:11)
  1.  E  S AMQQCASE=$S(AMQQ("LOW")=AMQQ("THI"):12,1:13)
  1.  Q
  1.  ;
  1. NUMBER ;
  1.  S AMQQ("CODE")=+AMQQ("LOW")-5
  1.  F  Q:AMQQ("LOW")]AMQQ("CODE")  S AMQQ("CODE")=+$O(@AMQQTGBL@("BA",AMQQ("CODE")_" "))
  1.  S AMQQ("CODE")=AMQQ("CODE")_" "
  1.  F  S AMQQ("NEWHI")=AMQQ("CODE"),AMQQ("CODE")=$O(@AMQQTGBL@("BA",AMQQ("CODE"))) Q:AMQQ("CODE")=AMQQ("LOW")
  1.  Q
  1.  ;
  1. LETTER ;
  1.  S AMQQ("LET")=$E(AMQQ("LOW"))_" "
  1.  F  S AMQQ("NEWHI")=AMQQ("LET"),AMQQ("LET")=$O(@AMQQTGBL@("BA",AMQQ("LET"))) Q:AMQQ("LET")=AMQQ("LOW")
  1.  Q
  1. EOJ ;
  1.  K AMQQCASE,AMQQDONE,AMQQNEXT,AMQQONE,AMQQVAL
  1.  Q
  1.  ;