- VENPCCG4 ; IHS/OIT/GIS - EXPORT ICD PREFERENCES FROM EXCEL BACK TO THE USER PREFERENCE FILES ;
- ;;2.6;PCC+;;NOV 12, 2007
- ;
- ;
- ;
- IMP ; IMPORT CODES FROM A STD ICD TXT FILE
- NEW I,X,Y,TMP,DIC,DIE,DA,DR,ICD,TXT,TEXT,IIEN,TYPE,POP,STG,NUM,FILE,TAB,CLASS,FREQ,PRV,STOP,CFIGIEN,PATH,TIEN,DLAYGO
- S CFIGIEN=$$CFG^VENPCCU I 'CFIGIEN Q
- S PATH=$G(^VEN(7.5,CFIGIEN,12)) I '$L(PATH) Q
- S TMP="^TMP(""VEN SAVE"",$J)" K @TMP
- S (DIC,DIE)="^VEN(7.1,",DIC(0)="L",FILE="ILC_ICD2.TXT",TAB=$C(9),DLAYGO=19707.1
- D OPEN^%ZISH("",PATH,FILE,"R")
- I POP=1 S FILE="ilc_icd2.txt" D OPEN^%ZISH("",PATH,FILE,"R")
- I POP=1 S FILE="ILC_ICD2.txt" D OPEN^%ZISH("",PATH,FILE,"R")
- I POP=1 S STOP=1 W !!,"Unable to locate the preferences file! Request terminated...",!! Q
- F NUM=1:1 R X:30 Q:$$STATUS^%ZISH S @TMP@(NUM)=X
- D CLOSE^%ZISH("")
- SET ;
- S PRV=$$PRV I 'PRV W !,"You must specify a provider! Request terminated..." Q
- N PGRP,STOP,PFLAG,%
- F NUM=1:1 S STG=$G(@TMP@(NUM)) Q:$G(STOP) Q:STG="" D I 'CLASS W !,"UNKNOWN CLASS TYPE: ",TYPE Q
- . S %=$E(STG,1,4) I %?1"***"1A S TYPE=$P(STG,"*",4),CLASS=$$CLASS(TYPE) Q
- . S ICD=$P(STG,TAB,1),TXT=$P(STG,TAB,2),FREQ=+$P(STG,TAB,4)
- . S X="""`"_PRV_""""
- . S @TMP@("FREQ",CLASS,FREQ,NUM)=X_U_ICD_U_TXT
- . Q
- UPDATE ;
- S CLASS=0
- F S CLASS=$O(@TMP@("FREQ",CLASS)) Q:'CLASS S (TOT,STOP)=0,FREQ=9999999 F Q:STOP S FREQ=$O(@TMP@("FREQ",CLASS,FREQ),-1) Q:FREQ="" S NUM=0 F S NUM=$O(@TMP@("FREQ",CLASS,FREQ,NUM)) Q:'NUM D I STOP Q
- . S TOT=TOT+1 I TOT>60 S STOP=1 Q
- . S STG=@TMP@("FREQ",CLASS,FREQ,NUM)
- . S X=$P(STG,U,1),IIEN=$P(STG,U,2),TXT=$P(STG,U,3),TXT=$TR(TXT,$C(34),"")
- . S Y=$$CK(PRV,IIEN,CLASS,TXT)
- . I 'Y D ^DIC I Y=-1 Q
- . S DA=+Y,DR=".02////"_IIEN_";.03////^S X=TXT;.04////"_CLASS
- . L +^VEN(7.1):0 I $T D ^DIE L -^VEN(7.1)
- . Q
- K @TMP
- Q
- ;
- CK(PRV,IIEN,CLASS,TXT) ; CK FOR OLD ENTRY
- N OK,IEN,PIEN,TYPE
- S (OK,IEN)=0
- F S IEN=$O(^VEN(7.1,"AC",IIEN,IEN)) Q:'IEN D I OK Q
- . S PIEN=$P($G(^VEN(7.1,IEN,0)),U,1) I PIEN'=PRV Q
- . S TYPE=$P($G(^VEN(7.1,IEN,0)),U,4) I TYPE'=CLASS Q
- . S TEXT=$P($G(^VEN(7.1,IEN,0)),U,3) I TEXT'=TXT Q
- . S OK=IEN
- . Q
- Q OK
- ;
- PRV() ;
- N DIC,X,Y
- S DIC("A")="Assign these preferences to which provider: "
- S DIC="^VA(200,",DIC(0)="AEQ"
- D ^DIC I Y=-1 Q 0
- Q +Y
- ;
- CLASS(X) ;
- I '$L(X) Q ""
- S X=$S(X="INFANT":1,X="PEDIATRIC":2,X="ADOLESCENT MALE":3,X="ADOLESCENT FEMALE":4,X="ADULT MALE":5,X="ADULT FEMALE":6,X="SENIOR MALE":7,X="SENIOR FEMALE":8,1:"")
- Q X
- ;
- VENPCCG4 ; IHS/OIT/GIS - EXPORT ICD PREFERENCES FROM EXCEL BACK TO THE USER PREFERENCE FILES ;
- +1 ;;2.6;PCC+;;NOV 12, 2007
- +2 ;
- +3 ;
- +4 ;
- IMP ; IMPORT CODES FROM A STD ICD TXT FILE
- +1 NEW I,X,Y,TMP,DIC,DIE,DA,DR,ICD,TXT,TEXT,IIEN,TYPE,POP,STG,NUM,FILE,TAB,CLASS,FREQ,PRV,STOP,CFIGIEN,PATH,TIEN,DLAYGO
- +2 SET CFIGIEN=$$CFG^VENPCCU
- IF 'CFIGIEN
- QUIT
- +3 SET PATH=$GET(^VEN(7.5,CFIGIEN,12))
- IF '$LENGTH(PATH)
- QUIT
- +4 SET TMP="^TMP(""VEN SAVE"",$J)"
- KILL @TMP
- +5 SET (DIC,DIE)="^VEN(7.1,"
- SET DIC(0)="L"
- SET FILE="ILC_ICD2.TXT"
- SET TAB=$CHAR(9)
- SET DLAYGO=19707.1
- +6 DO OPEN^%ZISH("",PATH,FILE,"R")
- +7 IF POP=1
- SET FILE="ilc_icd2.txt"
- DO OPEN^%ZISH("",PATH,FILE,"R")
- +8 IF POP=1
- SET FILE="ILC_ICD2.txt"
- DO OPEN^%ZISH("",PATH,FILE,"R")
- +9 IF POP=1
- SET STOP=1
- WRITE !!,"Unable to locate the preferences file! Request terminated...",!!
- QUIT
- +10 FOR NUM=1:1
- READ X:30
- IF $$STATUS^%ZISH
- QUIT
- SET @TMP@(NUM)=X
- +11 DO CLOSE^%ZISH("")
- SET ;
- +1 SET PRV=$$PRV
- IF 'PRV
- WRITE !,"You must specify a provider! Request terminated..."
- QUIT
- +2 NEW PGRP,STOP,PFLAG,%
- +3 FOR NUM=1:1
- SET STG=$GET(@TMP@(NUM))
- IF $GET(STOP)
- QUIT
- IF STG=""
- QUIT
- Begin DoDot:1
- +4 SET %=$EXTRACT(STG,1,4)
- IF %?1"***"1A
- SET TYPE=$PIECE(STG,"*",4)
- SET CLASS=$$CLASS(TYPE)
- QUIT
- +5 SET ICD=$PIECE(STG,TAB,1)
- SET TXT=$PIECE(STG,TAB,2)
- SET FREQ=+$PIECE(STG,TAB,4)
- +6 SET X="""`"_PRV_""""
- +7 SET @TMP@("FREQ",CLASS,FREQ,NUM)=X_U_ICD_U_TXT
- +8 QUIT
- End DoDot:1
- IF 'CLASS
- WRITE !,"UNKNOWN CLASS TYPE: ",TYPE
- QUIT
- UPDATE ;
- +1 SET CLASS=0
- +2 FOR
- SET CLASS=$ORDER(@TMP@("FREQ",CLASS))
- IF 'CLASS
- QUIT
- SET (TOT,STOP)=0
- SET FREQ=9999999
- FOR
- IF STOP
- QUIT
- SET FREQ=$ORDER(@TMP@("FREQ",CLASS,FREQ),-1)
- IF FREQ=""
- QUIT
- SET NUM=0
- FOR
- SET NUM=$ORDER(@TMP@("FREQ",CLASS,FREQ,NUM))
- IF 'NUM
- QUIT
- Begin DoDot:1
- +3 SET TOT=TOT+1
- IF TOT>60
- SET STOP=1
- QUIT
- +4 SET STG=@TMP@("FREQ",CLASS,FREQ,NUM)
- +5 SET X=$PIECE(STG,U,1)
- SET IIEN=$PIECE(STG,U,2)
- SET TXT=$PIECE(STG,U,3)
- SET TXT=$TRANSLATE(TXT,$CHAR(34),"")
- +6 SET Y=$$CK(PRV,IIEN,CLASS,TXT)
- +7 IF 'Y
- DO ^DIC
- IF Y=-1
- QUIT
- +8 SET DA=+Y
- SET DR=".02////"_IIEN_";.03////^S X=TXT;.04////"_CLASS
- +9 LOCK +^VEN(7.1):0
- IF $TEST
- DO ^DIE
- LOCK -^VEN(7.1)
- +10 QUIT
- End DoDot:1
- IF STOP
- QUIT
- +11 KILL @TMP
- +12 QUIT
- +13 ;
- CK(PRV,IIEN,CLASS,TXT) ; CK FOR OLD ENTRY
- +1 NEW OK,IEN,PIEN,TYPE
- +2 SET (OK,IEN)=0
- +3 FOR
- SET IEN=$ORDER(^VEN(7.1,"AC",IIEN,IEN))
- IF 'IEN
- QUIT
- Begin DoDot:1
- +4 SET PIEN=$PIECE($GET(^VEN(7.1,IEN,0)),U,1)
- IF PIEN'=PRV
- QUIT
- +5 SET TYPE=$PIECE($GET(^VEN(7.1,IEN,0)),U,4)
- IF TYPE'=CLASS
- QUIT
- +6 SET TEXT=$PIECE($GET(^VEN(7.1,IEN,0)),U,3)
- IF TEXT'=TXT
- QUIT
- +7 SET OK=IEN
- +8 QUIT
- End DoDot:1
- IF OK
- QUIT
- +9 QUIT OK
- +10 ;
- PRV() ;
- +1 NEW DIC,X,Y
- +2 SET DIC("A")="Assign these preferences to which provider: "
- +3 SET DIC="^VA(200,"
- SET DIC(0)="AEQ"
- +4 DO ^DIC
- IF Y=-1
- QUIT 0
- +5 QUIT +Y
- +6 ;
- CLASS(X) ;
- +1 IF '$LENGTH(X)
- QUIT ""
- +2 SET X=$SELECT(X="INFANT":1,X="PEDIATRIC":2,X="ADOLESCENT MALE":3,X="ADOLESCENT FEMALE":4,X="ADULT MALE":5,X="ADULT FEMALE":6,X="SENIOR MALE":7,X="SENIOR FEMALE":8,1:"")
- +3 QUIT X
- +4 ;
