- AMQQCMPK ; IHS/CMI/THL - COMPILES OR GROUPS AND CHECKS SEARCH EFFICIENCY ;
- ;;2.0;IHS PCC SUITE;;MAY 14, 2009
- ;-----
- I '$D(AMQQXX) W !,"Checking OR groups..."
- F AMQQKGNO=0:0 S AMQQKGNO=$O(^UTILITY("AMQQ OR",$J,1,AMQQKGNO)) Q:'AMQQKGNO D ATNO,RUN,SET,LOC,RESET
- EXIT K %,AMQQSER,AMQQISER,AMQQUATN,AMQQKONG,AMQQKGNO,AMQQKGAS,AMQQKGLA,AMQQKGLS,AMQQKGN,AMQQKGSN,AMQQNVAR,AMQQSVVR,AMQQVAR,G,I,Q,X,Y,Z,AMQT,AMQP,AMQQLINK,AMQQLINO,AMQQQ
- K ^UTILITY("AMQQ OR",$J)
- Q
- ;
- ATNO S (AMQQKGAS,AMQQKGSN)=""
- F AMQQSER=-999:0 S AMQQSER=$O(^UTILITY("AMQQ",$J,"WEIGHT",AMQQSER)) Q:AMQQSER="" F AMQQUATN=0:0 S AMQQUATN=$O(^UTILITY("AMQQ",$J,"WEIGHT",AMQQSER,AMQQUATN)) Q:'AMQQUATN D INDEX
- Q
- ;
- INDEX I '$D(^UTILITY("AMQQ OR",$J,1,AMQQKGNO,AMQQUATN)) Q
- S ^UTILITY("AMQQ OR",$J,2,AMQQKGNO,999-AMQQSER,AMQQUATN)=""
- I AMQQKGAS'="" S AMQQKGAS=AMQQKGAS_U
- S AMQQKGAS=AMQQKGAS_AMQQUATN
- S Y=0
- S X=1.9999
- F S X=$O(^AMQQ(1,+^UTILITY("AMQQ",$J,"Q",AMQQUATN),X)) Q:'X Q:X>2.999 S Y=Y+1
- I AMQQKGSN'="" S AMQQKGSN=AMQQKGSN_U
- S AMQQKGSN=AMQQKGSN_Y
- S AMQQKGLA=AMQQUATN
- Q
- ;
- RUN S AMQQLINO=1
- S AMQQVAR=9
- F AMQQISER=0:0 S AMQQISER=$O(^UTILITY("AMQQ OR",$J,2,AMQQKGNO,AMQQISER)) Q:'AMQQISER F AMQQUATN=0:0 S AMQQUATN=$O(^UTILITY("AMQQ OR",$J,2,AMQQKGNO,AMQQISER,AMQQUATN)) Q:'AMQQUATN D CMP
- Q
- ;
- CMP S Q=^UTILITY("AMQQ",$J,"Q",AMQQUATN)
- D TEMPLATE^AMQQCMP2
- Q
- ;
- SET S %=""
- S Y=0
- F I=1:1 S X=$P(AMQQKGSN,U,I) S:'X AMQQKGLS=% Q:'X S Y=Y+X S:%'="" %=%_U S %=%_Y
- S X=0,G="^UTILITY(""AMQQ OR"",$J,3)"
- INCX S X=$O(AMQV(X))
- I 'X Q
- S %=+AMQQKGLS
- I X<% S @G@(X)=$S(+AMQQKGAS=AMQQKGLA:98,1:(%+1))_U_(X+1) G INCX
- S @G@(X)=$S(+AMQQKGAS=AMQQKGLA:98,1:X+1)_U_99
- S AMQQKGAS=$P(AMQQKGAS,U,2,99)
- S AMQQKGLS=$P(AMQQKGLS,U,2,99)
- G INCX
- ;
- LOC F AMQQKGN=0:0 S AMQQKGN=$O(AMQV(AMQQKGN)) Q:'AMQQKGN D TR
- S AMQV("OR",AMQQKGNO,98)="I 0"
- S AMQV("OR",AMQQKGNO,99)="I 1"
- S AMQV("OR",AMQQKGNO,0)="S %=AMQP(0) N AMQT,AMQP S AMQP(0)=% X AMQV(""OR"","_AMQQKGNO_",1)"
- Q
- ;
- TR S %=^UTILITY("AMQQ OR",$J,3,AMQQKGN)
- S X="X AMQV(""OR"","_AMQQKGNO_",$S(AMQT("_AMQQKGN_"):"_$P(%,U,2)_",1:"_+%_"))"
- S AMQV("OR",AMQQKGNO,AMQQKGN)=$P(AMQV(AMQQKGN),"|30|")_X
- K AMQV(AMQQKGN)
- Q
- ;
- RESET S AMQQKGFG=$O(^UTILITY("AMQQ OR",$J,1,AMQQKGNO,""))
- F X=-999:0 S X=$O(^UTILITY("AMQQ",$J,"WEIGHT",X)) Q:'X F Y=0:0 S Y=$O(^UTILITY("AMQQ",$J,"WEIGHT",X,Y)) Q:'Y I $D(^UTILITY("AMQQ OR",$J,1,AMQQKGNO,Y)) K ^UTILITY("AMQQ",$J,"WEIGHT",X,Y),^UTILITY("AMQQ",$J,"Q",Y)
- S AMQQEXCD="S AMQP(0)=% N % X AMQV(""OR"",AMQQKGNO,1)"
- D KONG^AMQQATR
- S AMQQSER=X
- S ^UTILITY("AMQQ",$J,"WEIGHT",1-AMQQSER,AMQQKGFG)=""
- S ^UTILITY("AMQQ",$J,"Q",AMQQKGFG)="179^KONGLOMERATOR^K^^^^^^^^^^^1^"_AMQQKGNO
- K AMQQKGFG,AMQQECNT,AMQQEDEN,AMQQEINC,AMQQENUM,AMQQEXCD,AMQP,AMQT
- Q
- ;
- AMQQCMPK ; IHS/CMI/THL - COMPILES OR GROUPS AND CHECKS SEARCH EFFICIENCY ;
- +1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
- +2 ;-----
- +3 IF '$DATA(AMQQXX)
- WRITE !,"Checking OR groups..."
- +4 FOR AMQQKGNO=0:0
- SET AMQQKGNO=$ORDER(^UTILITY("AMQQ OR",$JOB,1,AMQQKGNO))
- IF 'AMQQKGNO
- QUIT
- DO ATNO
- DO RUN
- DO SET
- DO LOC
- DO RESET
- EXIT KILL %,AMQQSER,AMQQISER,AMQQUATN,AMQQKONG,AMQQKGNO,AMQQKGAS,AMQQKGLA,AMQQKGLS,AMQQKGN,AMQQKGSN,AMQQNVAR,AMQQSVVR,AMQQVAR,G,I,Q,X,Y,Z,AMQT,AMQP,AMQQLINK,AMQQLINO,AMQQQ
- +1 KILL ^UTILITY("AMQQ OR",$JOB)
- +2 QUIT
- +3 ;
- ATNO SET (AMQQKGAS,AMQQKGSN)=""
- +1 FOR AMQQSER=-999:0
- SET AMQQSER=$ORDER(^UTILITY("AMQQ",$JOB,"WEIGHT",AMQQSER))
- IF AMQQSER=""
- QUIT
- FOR AMQQUATN=0:0
- SET AMQQUATN=$ORDER(^UTILITY("AMQQ",$JOB,"WEIGHT",AMQQSER,AMQQUATN))
- IF 'AMQQUATN
- QUIT
- DO INDEX
- +2 QUIT
- +3 ;
- INDEX IF '$DATA(^UTILITY("AMQQ OR",$JOB,1,AMQQKGNO,AMQQUATN))
- QUIT
- +1 SET ^UTILITY("AMQQ OR",$JOB,2,AMQQKGNO,999-AMQQSER,AMQQUATN)=""
- +2 IF AMQQKGAS'=""
- SET AMQQKGAS=AMQQKGAS_U
- +3 SET AMQQKGAS=AMQQKGAS_AMQQUATN
- +4 SET Y=0
- +5 SET X=1.9999
- +6 FOR
- SET X=$ORDER(^AMQQ(1,+^UTILITY("AMQQ",$JOB,"Q",AMQQUATN),X))
- IF 'X
- QUIT
- IF X>2.999
- QUIT
- SET Y=Y+1
- +7 IF AMQQKGSN'=""
- SET AMQQKGSN=AMQQKGSN_U
- +8 SET AMQQKGSN=AMQQKGSN_Y
- +9 SET AMQQKGLA=AMQQUATN
- +10 QUIT
- +11 ;
- RUN SET AMQQLINO=1
- +1 SET AMQQVAR=9
- +2 FOR AMQQISER=0:0
- SET AMQQISER=$ORDER(^UTILITY("AMQQ OR",$JOB,2,AMQQKGNO,AMQQISER))
- IF 'AMQQISER
- QUIT
- FOR AMQQUATN=0:0
- SET AMQQUATN=$ORDER(^UTILITY("AMQQ OR",$JOB,2,AMQQKGNO,AMQQISER,AMQQUATN))
- IF 'AMQQUATN
- QUIT
- DO CMP
- +3 QUIT
- +4 ;
- CMP SET Q=^UTILITY("AMQQ",$JOB,"Q",AMQQUATN)
- +1 DO TEMPLATE^AMQQCMP2
- +2 QUIT
- +3 ;
- SET SET %=""
- +1 SET Y=0
- +2 FOR I=1:1
- SET X=$PIECE(AMQQKGSN,U,I)
- IF 'X
- SET AMQQKGLS=%
- IF 'X
- QUIT
- SET Y=Y+X
- IF %'=""
- SET %=%_U
- SET %=%_Y
- +3 SET X=0
- SET G="^UTILITY(""AMQQ OR"",$J,3)"
- INCX SET X=$ORDER(AMQV(X))
- +1 IF 'X
- QUIT
- +2 SET %=+AMQQKGLS
- +3 IF X<%
- SET @G@(X)=$SELECT(+AMQQKGAS=AMQQKGLA:98,1:(%+1))_U_(X+1)
- GOTO INCX
- +4 SET @G@(X)=$SELECT(+AMQQKGAS=AMQQKGLA:98,1:X+1)_U_99
- +5 SET AMQQKGAS=$PIECE(AMQQKGAS,U,2,99)
- +6 SET AMQQKGLS=$PIECE(AMQQKGLS,U,2,99)
- +7 GOTO INCX
- +8 ;
- LOC FOR AMQQKGN=0:0
- SET AMQQKGN=$ORDER(AMQV(AMQQKGN))
- IF 'AMQQKGN
- QUIT
- DO TR
- +1 SET AMQV("OR",AMQQKGNO,98)="I 0"
- +2 SET AMQV("OR",AMQQKGNO,99)="I 1"
- +3 SET AMQV("OR",AMQQKGNO,0)="S %=AMQP(0) N AMQT,AMQP S AMQP(0)=% X AMQV(""OR"","_AMQQKGNO_",1)"
- +4 QUIT
- +5 ;
- TR SET %=^UTILITY("AMQQ OR",$JOB,3,AMQQKGN)
- +1 SET X="X AMQV(""OR"","_AMQQKGNO_",$S(AMQT("_AMQQKGN_"):"_$PIECE(%,U,2)_",1:"_+%_"))"
- +2 SET AMQV("OR",AMQQKGNO,AMQQKGN)=$PIECE(AMQV(AMQQKGN),"|30|")_X
- +3 KILL AMQV(AMQQKGN)
- +4 QUIT
- +5 ;
- RESET SET AMQQKGFG=$ORDER(^UTILITY("AMQQ OR",$JOB,1,AMQQKGNO,""))
- +1 FOR X=-999:0
- SET X=$ORDER(^UTILITY("AMQQ",$JOB,"WEIGHT",X))
- IF 'X
- QUIT
- FOR Y=0:0
- SET Y=$ORDER(^UTILITY("AMQQ",$JOB,"WEIGHT",X,Y))
- IF 'Y
- QUIT
- IF $DATA(^UTILITY("AMQQ OR",$JOB,1,AMQQKGNO,Y))
- KILL ^UTILITY("AMQQ",$JOB,"WEIGHT",X,Y),^UTILITY("AMQQ",$JOB,"Q",Y)
- +2 SET AMQQEXCD="S AMQP(0)=% N % X AMQV(""OR"",AMQQKGNO,1)"
- +3 DO KONG^AMQQATR
- +4 SET AMQQSER=X
- +5 SET ^UTILITY("AMQQ",$JOB,"WEIGHT",1-AMQQSER,AMQQKGFG)=""
- +6 SET ^UTILITY("AMQQ",$JOB,"Q",AMQQKGFG)="179^KONGLOMERATOR^K^^^^^^^^^^^1^"_AMQQKGNO
- +7 KILL AMQQKGFG,AMQQECNT,AMQQEDEN,AMQQEINC,AMQQENUM,AMQQEXCD,AMQP,AMQT
- +8 QUIT
- +9 ;
