- AICDKWL ; IHS/OHPRD/ACC - LOOKUP DRIVER PROGRAM FOR "AND"ING INVERTED SEARCH ;
- ;;4.0;AICD;;DEC 03, 2014;Build 7
- ; ASSUMES AICDKSCH("TYPE"),("GBL"),("INDEX") AND AICDX
- ;IHS/CMI/LAB - CSV changed CHKSHRT to $$ICDDX
- S AICDXSAV=AICDX
- K Y
- S AICDT=AICDKSCH("TYPE"),AICDGBL=AICDKSCH("GBL"),AICDL=AICDX
- S AICDASK=$S('$D(DIC(0)):1,DIC(0)["E":1,1:0)
- I $D(^AICDKWLC("B",AICDT)) S AICDKWCT=$O(^AICDKWLC("B",AICDT,""))
- E S AICDKWCT=0 W:AICDASK *7,"<WARNING: SYNONYM/REPLACEMENT TABLE MISSING>",!
- INIT I AICDGBL'["^",AICDGBL'?1N.N,AICDGBL'?1N.N1"."1N.N S AICDGBL=$O(^DIC("B",AICDGBL,""))
- S:AICDGBL'["^" AICDGBL=^DIC(AICDGBL,0,"GL")
- S AICDREF=AICDGBL_""""_AICDKSCH("INDEX")_""",AICDWD)"
- S AICDREF1=AICDGBL
- S AICDREF2=$E(AICDREF,1,$L(AICDREF)-1)_","""")"
- S AICDREF3=AICDGBL_"^UTILITY(""AICDHITS"",$J,AICDH),0)"
- S AICDREF4=$E(AICDREF,1,$L(AICDREF)-1)_",AICDD)"
- ; NOTE: CHKSHRT HAS BEEN CHANGED TO USE "AB" BECAUSE THE
- ; B INDEX NO LONGER EXISTS FOR ICD FILES -- NEEDS TO
- ; BE IMPROVED TO PRESERVE GENERALITY OF LOOKUP!!!
- CHKSHRT ;
- G:$L(AICDL)>40 NOTSHRT G:'$D(^AICDKWLC(AICDKWCT,3,"B",$E(AICDL,1,30))) NOTSHRT
- F AICDI=0:0 S AICDI=$O(^AICDKWLC(AICDKWCT,3,"B",$E(AICDL,1,30),AICDI)) Q:AICDI="" Q:$P(^AICDKWLC(AICDKWCT,3,AICDI,0),U,1)=AICDL
- G:'AICDI NOTSHRT
- ;IHS/CMI/LAB - CSV commented line below and replaced
- ;S AICDL=$P(^AICDKWLC(AICDKWCT,3,AICDI,0),"^",2) S Y=$S($D(@(AICDREF1_"""AB"",AICDL)")):$O(^(AICDL,"")),1:-1)
- S AICDL=$P(^AICDKWLC(AICDKWCT,3,AICDI,0),"^",2) S Y=$P($$ICDDX^ICDCODE(AICDL,,,1),"^")
- G:Y<1 NOTSHRT
- I $D(@(AICDREF1_"Y,0)")) X:$D(DIC("S")) DIC("S") E S Y=-1
- G:Y<1 NOTSHRT
- K ^UTILITY("AICDHITS",$J) S ^UTILITY("AICDHITS",$J)=1,^UTILITY("AICDHITS",$J,1)=Y G VERIFY
- NOTSHRT ;
- G NOTSHRT^AICDKWL1
- VERIFY ;
- G VERIFY^AICDKWL1
- AICDKWL ; IHS/OHPRD/ACC - LOOKUP DRIVER PROGRAM FOR "AND"ING INVERTED SEARCH ;
- +1 ;;4.0;AICD;;DEC 03, 2014;Build 7
- +2 ; ASSUMES AICDKSCH("TYPE"),("GBL"),("INDEX") AND AICDX
- +3 ;IHS/CMI/LAB - CSV changed CHKSHRT to $$ICDDX
- +4 SET AICDXSAV=AICDX
- +5 KILL Y
- +6 SET AICDT=AICDKSCH("TYPE")
- SET AICDGBL=AICDKSCH("GBL")
- SET AICDL=AICDX
- +7 SET AICDASK=$SELECT('$DATA(DIC(0)):1,DIC(0)["E":1,1:0)
- +8 IF $DATA(^AICDKWLC("B",AICDT))
- SET AICDKWCT=$ORDER(^AICDKWLC("B",AICDT,""))
- +9 IF '$TEST
- SET AICDKWCT=0
- IF AICDASK
- WRITE *7,"<WARNING: SYNONYM/REPLACEMENT TABLE MISSING>",!
- INIT IF AICDGBL'["^"
- IF AICDGBL'?1N.N
- IF AICDGBL'?1N.N1"."1N.N
- SET AICDGBL=$ORDER(^DIC("B",AICDGBL,""))
- +1 IF AICDGBL'["^"
- SET AICDGBL=^DIC(AICDGBL,0,"GL")
- +2 SET AICDREF=AICDGBL_""""_AICDKSCH("INDEX")_""",AICDWD)"
- +3 SET AICDREF1=AICDGBL
- +4 SET AICDREF2=$EXTRACT(AICDREF,1,$LENGTH(AICDREF)-1)_","""")"
- +5 SET AICDREF3=AICDGBL_"^UTILITY(""AICDHITS"",$J,AICDH),0)"
- +6 SET AICDREF4=$EXTRACT(AICDREF,1,$LENGTH(AICDREF)-1)_",AICDD)"
- +7 ; NOTE: CHKSHRT HAS BEEN CHANGED TO USE "AB" BECAUSE THE
- +8 ; B INDEX NO LONGER EXISTS FOR ICD FILES -- NEEDS TO
- +9 ; BE IMPROVED TO PRESERVE GENERALITY OF LOOKUP!!!
- CHKSHRT ;
- +1 IF $LENGTH(AICDL)>40
- GOTO NOTSHRT
- IF '$DATA(^AICDKWLC(AICDKWCT,3,"B",$EXTRACT(AICDL,1,30)))
- GOTO NOTSHRT
- +2 FOR AICDI=0:0
- SET AICDI=$ORDER(^AICDKWLC(AICDKWCT,3,"B",$EXTRACT(AICDL,1,30),AICDI))
- IF AICDI=""
- QUIT
- IF $PIECE(^AICDKWLC(AICDKWCT,3,AICDI,0),U,1)=AICDL
- QUIT
- +3 IF 'AICDI
- GOTO NOTSHRT
- +4 ;IHS/CMI/LAB - CSV commented line below and replaced
- +5 ;S AICDL=$P(^AICDKWLC(AICDKWCT,3,AICDI,0),"^",2) S Y=$S($D(@(AICDREF1_"""AB"",AICDL)")):$O(^(AICDL,"")),1:-1)
- +6 SET AICDL=$PIECE(^AICDKWLC(AICDKWCT,3,AICDI,0),"^",2)
- SET Y=$PIECE($$ICDDX^ICDCODE(AICDL,,,1),"^")
- +7 IF Y<1
- GOTO NOTSHRT
- +8 IF $DATA(@(AICDREF1_"Y,0)"))
- IF $DATA(DIC("S"))
- XECUTE DIC("S")
- IF '$TEST
- SET Y=-1
- +9 IF Y<1
- GOTO NOTSHRT
- +10 KILL ^UTILITY("AICDHITS",$JOB)
- SET ^UTILITY("AICDHITS",$JOB)=1
- SET ^UTILITY("AICDHITS",$JOB,1)=Y
- GOTO VERIFY
- NOTSHRT ;
- +1 GOTO NOTSHRT^AICDKWL1
- VERIFY ;
- +1 GOTO VERIFY^AICDKWL1
