- AMQQATR ; IHS/CMI/THL - AMQQAT SUBROUTINE...COMPUTES DYNAMIC SEARCH RATING ;
- ;;2.0;IHS PCC SUITE;;MAY 14, 2009
- ;-----
- RUN N AMQQHIDE
- I +AMQQQ=33,AMQQQ[";;;NULL" S AMQQHIDE=""
- I $D(AMQQXX) S AMQQHIDE=""
- I $D(AMQQONE),AMQQONE'="" S $P(AMQQQ,U,11)=-.1 Q
- I +AMQQQ=3,$P(AMQQQ,U,8)="=" S $P(AMQQQ,U,11)=99 Q
- CHECK I $P(^AMQQ(1,+AMQQQ,0),U,7),AMQQQ'[";ANY^",AMQQQ'[";NULL^",$P(AMQQQ,U,17)="" D ^AMQQATR1 G EXIT
- I '$D(^AMQQ(1,+AMQQQ,3)) S $P(AMQQQ,U,11)=-.1 Q
- S %=$P(AMQQQ,U,2)
- I %="DIAGNOSIS"!(%="RX") D DX Q
- I $P(AMQQQ,U,17)'=""!(+AMQQQ=212) D ^AMQQATR2 G EXIT
- I '$D(AMQQHIDE) W !,"Computing Search Efficiency Rating...."
- S Q=AMQQQ
- I $P(Q,U,2)="FILE ENTRY" D FILE S AMQQECPR=% D SAMPLE G EXIT
- S AMQQEXCD=^AMQQ(1,+Q,3)
- S AMQQENCO=$P(Q,U,6)
- S AMQQECPR=$P(Q,U,9)
- S AMQQESBL=$P(Q,U,8)
- S AMQQEVAL=""
- I $P(AMQQECPR,";",4)["EXIST"!($P(AMQQECPR,";",4)["NULL") S AMQQECMP="I AMQQEVAL'=""""" D SAMPLE G EXIT
- D @("FILTER"_$P(Q,U,3)_"^AMQQATR0")
- D SAMPLE
- EXIT K %,Q,AMQQSER,X,Y,Z,AMQQY,AMQQEVAL,AMQQECMP,AMQQENUM,AMQQEDEN,AMQQEINC,AMQQESBL,AMQQEXCD,AMQQECNT,AMQQECPR,AMQQENCO,AMQQHIDE
- Q
- ;
- SAMPLE D @("SAMPLE"_AMQQCCLS)
- S X=AMQQENUM/AMQQEDEN
- I 'X S X=.01
- I AMQQECPR["NULL" G SETSER
- S X=(1-X)/$S($D(AMQQKONG):1,$P(^AMQQ(1,+Q,0),U,8):X,+Q=40:X,+Q=176:X,1:1)
- SETSER S AMQQSER=$J(X,1,2)
- S %=$P(^AMQQ(1,+AMQQQ,0),U,15)
- I %'="" S AMQQSER=AMQQSER_":"_%
- S $P(AMQQQ,U,11)=AMQQSER
- Q
- ;
- SAMPLEH S %=1
- S AMQQENUM=0
- S X=$P(@AMQQ200(16)@(0),U,4)
- S AMQQEINC=$S(X<50:0,1:(X\50))
- S AMQQECNT=0
- F AMQQEDEN=0:1 S %=$O(@AMQQ200(16)@(%)) Q:%'=+% X AMQQEXCD S:$T AMQQENUM=AMQQENUM+1 S %=%+AMQQEINC W:'$D(AMQQHIDE) "." S AMQQECNT=AMQQECNT+1 I AMQQECNT>50 Q
- Q
- ;
- SAMPLEP S %=1
- S AMQQENUM=0
- S X=$P(^DPT(0),U,4)
- S AMQQEINC=$S(X<50:0,1:(X\50))
- S AMQQECNT=0
- F AMQQEDEN=0:1 S %=$O(^DPT(%)) Q:%'=+% X AMQQEXCD S:$T AMQQENUM=AMQQENUM+1 S %=%+AMQQEINC W:'$D(AMQQHIDE) "." S AMQQECNT=AMQQECNT+1 I AMQQECNT>50 Q
- Q
- ;
- SAMPLEV S %=1
- S AMQQENUM=0
- S X=$P(^AUPNVSIT(0),U,4)
- S AMQQEINC=$S(X<50:0,1:(X\50))
- S AMQQECNT=0
- F AMQQEDEN=0:1 S %=$O(^AUPNVSIT(%)) Q:%'=+% X AMQQEXCD S:$T AMQQENUM=AMQQENUM+1 S %=%+AMQQEINC W:'$D(AMQQHIDE) "." S AMQQECNT=AMQQECNT+1 I AMQQECNT>50 Q
- Q
- ;
- SAMPLED S %=1,AMQQENUM=0
- S X=$P(^AUPNVPOV(0),U,4)
- S AMQQEINC=$S(X<50:0,1:(X\50))
- S AMQQECNT=0
- F AMQQEDEN=0:1 S %=$O(^AUPNVPOV(%)) Q:%'=+% X AMQQEXCD S:$T AMQQENUM=AMQQENUM+1 S %=%+AMQQEINC W:'$D(AMQQHIDE) "." S AMQQECNT=AMQQECNT+1 I AMQQECNT>50 Q
- Q
- ;
- DX I $D(^UTILITY("AMQQ TAX",$J,AMQQURGN,"--")) S $P(AMQQQ,U,11)=-1 Q
- I '$D(AMQQHIDE) W !,"Computing Search Efficiency Rating...."
- S %=0
- F I=0:1 S %=$O(^UTILITY("AMQQ TAX",$J,AMQQURGN,%)) Q:'% W:'$D(AMQQHIDE) "."
- S %=.99/((.01)*(4+(I/16)))
- S %=$J(%,1,2)
- S $P(AMQQQ,U,11)=%
- I $G(AMQQUSQN),'$D(^UTILITY("AMQQ",$J,"SQ",AMQQUSQN,"NULL")) S $P(AMQQQ,U,11)=%_":"_20
- Q
- ;
- FILE I +Q<178 S %=$P(Q,U,9),AMQQEXCD="I "_$S(+Q=177:"'",1:"")_"$D(^"_$P(%,";")_""""_$P(%,";",2)_""",%))" Q
- S %=$P(Q,U,9)
- S AMQQEXCD="I $D(^UTILITY(""AMQQ FRAND"","_$P(%,";",3)_","_$P(%,";",6)_",%))"
- Q
- ;
- KONG ; ENTRY POINT FROM AMQQCMPK
- I $D(AMQQXX) S AMQQHIDE=""
- D @("SAMPLE"_AMQQCCLS)
- S X=AMQQENUM/AMQQEDEN
- I 'X S X=.01
- S X=1-X,X=$J(X,1,2)
- K AMQQHIDE
- Q
- ;
- AMQQATR ; IHS/CMI/THL - AMQQAT SUBROUTINE...COMPUTES DYNAMIC SEARCH RATING ;
- +1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
- +2 ;-----
- RUN NEW AMQQHIDE
- +1 IF +AMQQQ=33
- IF AMQQQ[";;;NULL"
- SET AMQQHIDE=""
- +2 IF $DATA(AMQQXX)
- SET AMQQHIDE=""
- +3 IF $DATA(AMQQONE)
- IF AMQQONE'=""
- SET $PIECE(AMQQQ,U,11)=-.1
- QUIT
- +4 IF +AMQQQ=3
- IF $PIECE(AMQQQ,U,8)="="
- SET $PIECE(AMQQQ,U,11)=99
- QUIT
- CHECK IF $PIECE(^AMQQ(1,+AMQQQ,0),U,7)
- IF AMQQQ'[";ANY^"
- IF AMQQQ'[";NULL^"
- IF $PIECE(AMQQQ,U,17)=""
- DO ^AMQQATR1
- GOTO EXIT
- +1 IF '$DATA(^AMQQ(1,+AMQQQ,3))
- SET $PIECE(AMQQQ,U,11)=-.1
- QUIT
- +2 SET %=$PIECE(AMQQQ,U,2)
- +3 IF %="DIAGNOSIS"!(%="RX")
- DO DX
- QUIT
- +4 IF $PIECE(AMQQQ,U,17)'=""!(+AMQQQ=212)
- DO ^AMQQATR2
- GOTO EXIT
- +5 IF '$DATA(AMQQHIDE)
- WRITE !,"Computing Search Efficiency Rating...."
- +6 SET Q=AMQQQ
- +7 IF $PIECE(Q,U,2)="FILE ENTRY"
- DO FILE
- SET AMQQECPR=%
- DO SAMPLE
- GOTO EXIT
- +8 SET AMQQEXCD=^AMQQ(1,+Q,3)
- +9 SET AMQQENCO=$PIECE(Q,U,6)
- +10 SET AMQQECPR=$PIECE(Q,U,9)
- +11 SET AMQQESBL=$PIECE(Q,U,8)
- +12 SET AMQQEVAL=""
- +13 IF $PIECE(AMQQECPR,";",4)["EXIST"!($PIECE(AMQQECPR,";",4)["NULL")
- SET AMQQECMP="I AMQQEVAL'="""""
- DO SAMPLE
- GOTO EXIT
- +14 DO @("FILTER"_$PIECE(Q,U,3)_"^AMQQATR0")
- +15 DO SAMPLE
- EXIT KILL %,Q,AMQQSER,X,Y,Z,AMQQY,AMQQEVAL,AMQQECMP,AMQQENUM,AMQQEDEN,AMQQEINC,AMQQESBL,AMQQEXCD,AMQQECNT,AMQQECPR,AMQQENCO,AMQQHIDE
- +1 QUIT
- +2 ;
- SAMPLE DO @("SAMPLE"_AMQQCCLS)
- +1 SET X=AMQQENUM/AMQQEDEN
- +2 IF 'X
- SET X=.01
- +3 IF AMQQECPR["NULL"
- GOTO SETSER
- +4 SET X=(1-X)/$SELECT($DATA(AMQQKONG):1,$PIECE(^AMQQ(1,+Q,0),U,8):X,+Q=40:X,+Q=176:X,1:1)
- SETSER SET AMQQSER=$JUSTIFY(X,1,2)
- +1 SET %=$PIECE(^AMQQ(1,+AMQQQ,0),U,15)
- +2 IF %'=""
- SET AMQQSER=AMQQSER_":"_%
- +3 SET $PIECE(AMQQQ,U,11)=AMQQSER
- +4 QUIT
- +5 ;
- SAMPLEH SET %=1
- +1 SET AMQQENUM=0
- +2 SET X=$PIECE(@AMQQ200(16)@(0),U,4)
- +3 SET AMQQEINC=$SELECT(X<50:0,1:(X\50))
- +4 SET AMQQECNT=0
- +5 FOR AMQQEDEN=0:1
- SET %=$ORDER(@AMQQ200(16)@(%))
- IF %'=+%
- QUIT
- XECUTE AMQQEXCD
- IF $TEST
- SET AMQQENUM=AMQQENUM+1
- SET %=%+AMQQEINC
- IF '$DATA(AMQQHIDE)
- WRITE "."
- SET AMQQECNT=AMQQECNT+1
- IF AMQQECNT>50
- QUIT
- +6 QUIT
- +7 ;
- SAMPLEP SET %=1
- +1 SET AMQQENUM=0
- +2 SET X=$PIECE(^DPT(0),U,4)
- +3 SET AMQQEINC=$SELECT(X<50:0,1:(X\50))
- +4 SET AMQQECNT=0
- +5 FOR AMQQEDEN=0:1
- SET %=$ORDER(^DPT(%))
- IF %'=+%
- QUIT
- XECUTE AMQQEXCD
- IF $TEST
- SET AMQQENUM=AMQQENUM+1
- SET %=%+AMQQEINC
- IF '$DATA(AMQQHIDE)
- WRITE "."
- SET AMQQECNT=AMQQECNT+1
- IF AMQQECNT>50
- QUIT
- +6 QUIT
- +7 ;
- SAMPLEV SET %=1
- +1 SET AMQQENUM=0
- +2 SET X=$PIECE(^AUPNVSIT(0),U,4)
- +3 SET AMQQEINC=$SELECT(X<50:0,1:(X\50))
- +4 SET AMQQECNT=0
- +5 FOR AMQQEDEN=0:1
- SET %=$ORDER(^AUPNVSIT(%))
- IF %'=+%
- QUIT
- XECUTE AMQQEXCD
- IF $TEST
- SET AMQQENUM=AMQQENUM+1
- SET %=%+AMQQEINC
- IF '$DATA(AMQQHIDE)
- WRITE "."
- SET AMQQECNT=AMQQECNT+1
- IF AMQQECNT>50
- QUIT
- +6 QUIT
- +7 ;
- SAMPLED SET %=1
- SET AMQQENUM=0
- +1 SET X=$PIECE(^AUPNVPOV(0),U,4)
- +2 SET AMQQEINC=$SELECT(X<50:0,1:(X\50))
- +3 SET AMQQECNT=0
- +4 FOR AMQQEDEN=0:1
- SET %=$ORDER(^AUPNVPOV(%))
- IF %'=+%
- QUIT
- XECUTE AMQQEXCD
- IF $TEST
- SET AMQQENUM=AMQQENUM+1
- SET %=%+AMQQEINC
- IF '$DATA(AMQQHIDE)
- WRITE "."
- SET AMQQECNT=AMQQECNT+1
- IF AMQQECNT>50
- QUIT
- +5 QUIT
- +6 ;
- DX IF $DATA(^UTILITY("AMQQ TAX",$JOB,AMQQURGN,"--"))
- SET $PIECE(AMQQQ,U,11)=-1
- QUIT
- +1 IF '$DATA(AMQQHIDE)
- WRITE !,"Computing Search Efficiency Rating...."
- +2 SET %=0
- +3 FOR I=0:1
- SET %=$ORDER(^UTILITY("AMQQ TAX",$JOB,AMQQURGN,%))
- IF '%
- QUIT
- IF '$DATA(AMQQHIDE)
- WRITE "."
- +4 SET %=.99/((.01)*(4+(I/16)))
- +5 SET %=$JUSTIFY(%,1,2)
- +6 SET $PIECE(AMQQQ,U,11)=%
- +7 IF $GET(AMQQUSQN)
- IF '$DATA(^UTILITY("AMQQ",$JOB,"SQ",AMQQUSQN,"NULL"))
- SET $PIECE(AMQQQ,U,11)=%_":"_20
- +8 QUIT
- +9 ;
- FILE IF +Q<178
- SET %=$PIECE(Q,U,9)
- SET AMQQEXCD="I "_$SELECT(+Q=177:"'",1:"")_"$D(^"_$PIECE(%,";")_""""_$PIECE(%,";",2)_""",%))"
- QUIT
- +1 SET %=$PIECE(Q,U,9)
- +2 SET AMQQEXCD="I $D(^UTILITY(""AMQQ FRAND"","_$PIECE(%,";",3)_","_$PIECE(%,";",6)_",%))"
- +3 QUIT
- +4 ;
- KONG ; ENTRY POINT FROM AMQQCMPK
- +1 IF $DATA(AMQQXX)
- SET AMQQHIDE=""
- +2 DO @("SAMPLE"_AMQQCCLS)
- +3 SET X=AMQQENUM/AMQQEDEN
- +4 IF 'X
- SET X=.01
- +5 SET X=1-X
- SET X=$JUSTIFY(X,1,2)
- +6 KILL AMQQHIDE
- +7 QUIT
- +8 ;
