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 ;
