VENPCCG ; IHS/OIT/GIS - GET ICD PREFERENCES ;
;;2.6;PCC+;;NOV 12, 2007
;
;
;
A ; EP-DRIVER
N TMP,CFIGIEN,PATH,VENDEPT,%Q,%T,%Y,AGE,AGEBUK,AGEGRP,AGESEX,AP,BD,C,CC,DESALL,DUB,ED,I,ICD,ICDPTR,MOST,MOSTPNP
N NARR,PAT,PNP,POP,PROVLG,SEX,TOTPN,TYPE,VD,VDFN,VENFLNO,VENT,VIS,DIR,DOB,PROVFLG,FL,DXPRV
S TMP="^TMP(""VEN PREF"",$J)" K @TMP
S CFIGIEN=$$CFG^VENPCCU I 'CFIGIEN Q
S PATH=$G(^VEN(7.5,CFIGIEN,12)) I '$L(PATH) Q
D ^XBCLS
W !!,"Extract most commonly used Diagnoses...",!!
;
;
DATES ; GET DATES FOR REPORT
K DIR S DIR(0)="DO",DIR("A")="Enter start date for the search" D ^DIR Q:Y=""!$D(DUOUT)!$D(DLOUT) S BD=+Y
S ED=DT ; FORCE ENDING DATE TYO BE TODAY
;
TYPE ;
K DIR
S DIR(0)="SX^C:Certain Provider Class(es);P:Individual Provider(s);A:All"
S DIR("A")="ENTER Code for Search Criteria"
D ^DIR
Q:$D(DIRUT)
S TYPE=Y
I TYPE="C" K VEN("PC") D CLASS I '$D(VEN("PC")) G TYPE
I TYPE="P" K VEN("PRV") D PRV I '$D(VEN("PRV")) G TYPE
;
T1 ; SET FILTER FLAGS
;
S @TMP@("VPOV",0)=BD_"^"_ED
I TYPE="C" D
. S $P(@TMP@("VPOV",0),"^",3)="CLINIC"
. I (VEN("PC",0)=1) S $P(@TMP@("VPOV",0),"^",3)=$O(VEN("PC",0))
. Q
I TYPE="P" D
. S $P(@TMP@("VPOV",0),"^",3)="PROVIDERS"
. I (VEN("PRV",0)=1) S $P(@TMP@("VPOV",0),"^",3)=$O(VEN("PRV",0))
. Q
D DEPT ; ASK IF USER WANTS TO ADD A DEPARTMENT FILTER
I $G(NEWDXP) S DXPRV=$$GETPRV I 'DXPRV W !,"No provider specified. Request terminated..." Q ; ASSIGNED PROVIDER
; IF NO DEPT IS SELECTED, THEN IT DEFAULTS TO "ALL"
CONF W !!,"This will take a while..."
I $G(NEWDXP) H 1
E W !,"Are you sure you want to proceed" S %=1 D YN^DICN I %'=1 W !,"BYE!" Q
D ST^VENPCCG1 ; MINE RAW DATA
D FILE^VENPCCG2 ; FORMAT/SUBMIT DATA FOR THE "TOP 100"
;
END ;
Q
;
PRV ;
N DIC,PRV,MORE,X,Y,Z
S MORE=0
AP S DIC("A")="Enter "_$S(MORE:"another ",1:"")_"provider: "
S DIC(0)="AEMQ"
S %=$C(68)_"IC(6,",DIC=$S($G(^DD(9000010.06,.01,0))[%:(U_%),1:"^VA(200,")
D ^DIC
K DIC,DA Q:+Y<0
S VEN("PRV",+Y)=""
S VEN("PRV",0)=$G(VEN("PRV",0))+1
S MORE=1 G AP
Q
CLASS ;
N X,Y,DIC,CLASS,MORE S MORE=0
AC S DIC("A")="Enter "_$S(MORE:"another ",1:"")_"Provider Class: ",DIC="^DIC(7,",DIC(0)="AEMQ" D ^DIC K DIC,DA Q:Y<0
S VEN("PC",+Y)=""
S VEN("PC",0)=$G(VEN("PC",0))+1
S MORE=1 G AC
Q
;
DEPT ; FILTER RESULTS BY DEPARTMENT
N DIR,X,Y,DIC
W ! S DIR(0)="YO",DIR("A")="Do you want to limit search results to one particular clinic",DIR("B")="NO" KILL DA D ^DIR KILL DIR
I Y'=1 Q
S DIC(0)="AEQM",DIC=40.7,DIC("A")="Name the clinic: "
D ^DIC I Y=-1 Q
S VENDEPT=+Y ; DEPT FILTER FLAG
Q
;
GETPRV() ; EP-RETURN THE IEN OF THE ACTUAL OR GENERIC PROVIDER
N PIEN,CFIGIEN
S PIEN="",CFIGIEN=$$CFG^VENPCCU
I '$G(VENDEPT),$G(TYPE)="A",'$P($G(^VEN(7.5,CFIGIEN,0)),U,13) D Q PIEN ; GET INSTITUTIONAL GENERIC PROVIDER
. W !!,"There is no generic provider listed for this institution...",!,"You must enter one now."
. W !,"Enter a name like 'PIMC,GENERIC PROVIDER' OR 'CROWNPOINT,GENERIC PROVIDER'"
. W !,"You can also enter '??' or a partial name like 'PIMC",!,"to see if a suitable name already exists."
. W !,"If you are asked to enter INITIALS, just type them in; e.g., 'GPP'."
. W !,"If you are asked to enter a mail code, press the return key.",!
. S DIC="^VA(200,",DIC(0)="AEQL",DLAYGO=200,DIC("A")="Generic Provider: "
. D ^DIC I Y=-1 Q
. S PIEN=+Y
. S DIE="^VEN(7.5,",DR=".13////"_PIEN,DA=CFIGIEN
. L +^VEN(7.5,DA):0 I $T D ^DIE L -^VEN(7.5,DA) ; STORE THE GENERIC PROVIDER IN THE CONFIG FILE
. Q
I '$G(VENDEPT),$G(TYPE)="A" D Q PIEN
. S PIEN=$P($G(^VEN(7.5,CFIGIEN,0)),U,13) ; USE INSTITUTIONAL GENERIC PROVIDER
. W !!,"Preferences will be assigned",!,"to the Default Institutional Provider: ",$P($G(^VA(200,PIEN,0)),U)
. Q
I $G(VENDEPT),'$P($G(^VEN(7.95,VENDEPT,2)),U,2) D Q PIEN ; CREATE THE DEPARTMENT'S GENERIC PROVIDER
. W !!,"There is no generic provider listed for this clinic/department...",!,"You must enter one now."
. D GP I 'PIEN Q
. S DIE="^VEN(7.95,",DA=VENDEPT,DR="2.02////"_PIEN
. L +^VEN(7.95,DA):0 I $T D ^DIE L -^VEN(7.95,DA) ; ASSIGN THE GENERIC PROVIDER TO THE CLINIC
. Q
I $G(VENDEPT) D Q PIEN ; USE THE EXISTING DEPARTMENTAL PROVIDER
. S PIEN=$P($G(^VEN(7.95,VENDEPT,2)),U,2) I 'PIEN Q
. W !!,"Preferred diagnoses will be assigned to ",$P($G(^VA(200,PIEN,0)),U)
. Q
I TYPE="P",$G(VEN("PRV",0))=1 D Q PIEN ; ASSIGN PREFERENCES TO AN INDIVIDUAL PROVIDER
. S PIEN=$O(VEN("PRV",0)) I 'PIEN Q
. W !!,"Preferred diagnoses will be assigned to ",$P($G(^VA(200,PIEN,0)),U)
. Q
W !!,"You must assign a generic provider to represent this group of providers..." ; DEFINE PROVIDER GROUP
D GP
Q PIEN
;
GP ; EP-GET A GENERIC PROVIDER
W !!,"Enter a name like 'PIMC,PEDIATRICIAN' OR 'CROWNPOINT,FAMILY DOCTOR'"
W !,"You can also enter '??' or a partial name like 'PIMC,'",!,"to see if a suitable name already exists."
W !,"If you are asked to enter INITIALS, just type them in; e.g., 'FDC'."
W !,"If you are asked to enter a mail code, press the return key.",!
S DIC="^VA(200,",DIC(0)="AEQL",DLAYGO=200,DIC("A")="Clinic/department Provider: "
D ^DIC I Y=-1 Q
S PIEN=+Y
W !,"NOTE: In the future, this generic provider can be assigned to other PCC+ forms or clincs",!!
Q
;
NEWLIST ; EP - NEW WAY TO SAVE DX PREFERENCES
N NEWDXP,DIC,X,Y,%
W !!
W ?20,"***** WARNING ****"
W !,"This procedure may delete exsiting preferences of selected provider(s)!!!"
W !,"Do you want to proceed"
S %="" D YN^DICN
I %'=1 D ^XBFMK Q
S DIC("A")="Enter the name of the ICD Preference Group: " S DIC("B")="PRIMARY"
S DIC="^VEN(7.33,",DIC(0)="AEQL",DLAYGO=19707.33
D ^DIC I Y=-1 D ^XBFMK Q
S NEWDXP=+Y ; STORE THE PREFERENCE GROUP IEN IN NEWDXP
D ^XBFMK
D A
Q
;
VENPCCG ; IHS/OIT/GIS - GET ICD PREFERENCES ;
+1 ;;2.6;PCC+;;NOV 12, 2007
+2 ;
+3 ;
+4 ;
A ; EP-DRIVER
+1 NEW TMP,CFIGIEN,PATH,VENDEPT,%Q,%T,%Y,AGE,AGEBUK,AGEGRP,AGESEX,AP,BD,C,CC,DESALL,DUB,ED,I,ICD,ICDPTR,MOST,MOSTPNP
+2 NEW NARR,PAT,PNP,POP,PROVLG,SEX,TOTPN,TYPE,VD,VDFN,VENFLNO,VENT,VIS,DIR,DOB,PROVFLG,FL,DXPRV
+3 SET TMP="^TMP(""VEN PREF"",$J)"
KILL @TMP
+4 SET CFIGIEN=$$CFG^VENPCCU
IF 'CFIGIEN
QUIT
+5 SET PATH=$GET(^VEN(7.5,CFIGIEN,12))
IF '$LENGTH(PATH)
QUIT
+6 DO ^XBCLS
+7 WRITE !!,"Extract most commonly used Diagnoses...",!!
+8 ;
+9 ;
DATES ; GET DATES FOR REPORT
+1 KILL DIR
SET DIR(0)="DO"
SET DIR("A")="Enter start date for the search"
DO ^DIR
IF Y=""!$DATA(DUOUT)!$DATA(DLOUT)
QUIT
SET BD=+Y
+2 ; FORCE ENDING DATE TYO BE TODAY
SET ED=DT
+3 ;
TYPE ;
+1 KILL DIR
+2 SET DIR(0)="SX^C:Certain Provider Class(es);P:Individual Provider(s);A:All"
+3 SET DIR("A")="ENTER Code for Search Criteria"
+4 DO ^DIR
+5 IF $DATA(DIRUT)
QUIT
+6 SET TYPE=Y
+7 IF TYPE="C"
KILL VEN("PC")
DO CLASS
IF '$DATA(VEN("PC"))
GOTO TYPE
+8 IF TYPE="P"
KILL VEN("PRV")
DO PRV
IF '$DATA(VEN("PRV"))
GOTO TYPE
+9 ;
T1 ; SET FILTER FLAGS
+1 ;
+2 SET @TMP@("VPOV",0)=BD_"^"_ED
+3 IF TYPE="C"
Begin DoDot:1
+4 SET $PIECE(@TMP@("VPOV",0),"^",3)="CLINIC"
+5 IF (VEN("PC",0)=1)
SET $PIECE(@TMP@("VPOV",0),"^",3)=$ORDER(VEN("PC",0))
+6 QUIT
End DoDot:1
+7 IF TYPE="P"
Begin DoDot:1
+8 SET $PIECE(@TMP@("VPOV",0),"^",3)="PROVIDERS"
+9 IF (VEN("PRV",0)=1)
SET $PIECE(@TMP@("VPOV",0),"^",3)=$ORDER(VEN("PRV",0))
+10 QUIT
End DoDot:1
+11 ; ASK IF USER WANTS TO ADD A DEPARTMENT FILTER
DO DEPT
+12 ; ASSIGNED PROVIDER
IF $GET(NEWDXP)
SET DXPRV=$$GETPRV
IF 'DXPRV
WRITE !,"No provider specified. Request terminated..."
QUIT
+13 ; IF NO DEPT IS SELECTED, THEN IT DEFAULTS TO "ALL"
CONF WRITE !!,"This will take a while..."
+1 IF $GET(NEWDXP)
HANG 1
+2 IF '$TEST
WRITE !,"Are you sure you want to proceed"
SET %=1
DO YN^DICN
IF %'=1
WRITE !,"BYE!"
QUIT
+3 ; MINE RAW DATA
DO ST^VENPCCG1
+4 ; FORMAT/SUBMIT DATA FOR THE "TOP 100"
DO FILE^VENPCCG2
+5 ;
END ;
+1 QUIT
+2 ;
PRV ;
+1 NEW DIC,PRV,MORE,X,Y,Z
+2 SET MORE=0
AP SET DIC("A")="Enter "_$SELECT(MORE:"another ",1:"")_"provider: "
+1 SET DIC(0)="AEMQ"
+2 SET %=$CHAR(68)_"IC(6,"
SET DIC=$SELECT($GET(^DD(9000010.06,.01,0))[%:(U_%),1:"^VA(200,")
+3 DO ^DIC
+4 KILL DIC,DA
IF +Y<0
QUIT
+5 SET VEN("PRV",+Y)=""
+6 SET VEN("PRV",0)=$GET(VEN("PRV",0))+1
+7 SET MORE=1
GOTO AP
+8 QUIT
CLASS ;
+1 NEW X,Y,DIC,CLASS,MORE
SET MORE=0
AC SET DIC("A")="Enter "_$SELECT(MORE:"another ",1:"")_"Provider Class: "
SET DIC="^DIC(7,"
SET DIC(0)="AEMQ"
DO ^DIC
KILL DIC,DA
IF Y<0
QUIT
+1 SET VEN("PC",+Y)=""
+2 SET VEN("PC",0)=$GET(VEN("PC",0))+1
+3 SET MORE=1
GOTO AC
+4 QUIT
+5 ;
DEPT ; FILTER RESULTS BY DEPARTMENT
+1 NEW DIR,X,Y,DIC
+2 WRITE !
SET DIR(0)="YO"
SET DIR("A")="Do you want to limit search results to one particular clinic"
SET DIR("B")="NO"
KILL DA
DO ^DIR
KILL DIR
+3 IF Y'=1
QUIT
+4 SET DIC(0)="AEQM"
SET DIC=40.7
SET DIC("A")="Name the clinic: "
+5 DO ^DIC
IF Y=-1
QUIT
+6 ; DEPT FILTER FLAG
SET VENDEPT=+Y
+7 QUIT
+8 ;
GETPRV() ; EP-RETURN THE IEN OF THE ACTUAL OR GENERIC PROVIDER
+1 NEW PIEN,CFIGIEN
+2 SET PIEN=""
SET CFIGIEN=$$CFG^VENPCCU
+3 ; GET INSTITUTIONAL GENERIC PROVIDER
IF '$GET(VENDEPT)
IF $GET(TYPE)="A"
IF '$PIECE($GET(^VEN(7.5,CFIGIEN,0)),U,13)
Begin DoDot:1
+4 WRITE !!,"There is no generic provider listed for this institution...",!,"You must enter one now."
+5 WRITE !,"Enter a name like 'PIMC,GENERIC PROVIDER' OR 'CROWNPOINT,GENERIC PROVIDER'"
+6 WRITE !,"You can also enter '??' or a partial name like 'PIMC",!,"to see if a suitable name already exists."
+7 WRITE !,"If you are asked to enter INITIALS, just type them in; e.g., 'GPP'."
+8 WRITE !,"If you are asked to enter a mail code, press the return key.",!
+9 SET DIC="^VA(200,"
SET DIC(0)="AEQL"
SET DLAYGO=200
SET DIC("A")="Generic Provider: "
+10 DO ^DIC
IF Y=-1
QUIT
+11 SET PIEN=+Y
+12 SET DIE="^VEN(7.5,"
SET DR=".13////"_PIEN
SET DA=CFIGIEN
+13 ; STORE THE GENERIC PROVIDER IN THE CONFIG FILE
LOCK +^VEN(7.5,DA):0
IF $TEST
DO ^DIE
LOCK -^VEN(7.5,DA)
+14 QUIT
End DoDot:1
QUIT PIEN
+15 IF '$GET(VENDEPT)
IF $GET(TYPE)="A"
Begin DoDot:1
+16 ; USE INSTITUTIONAL GENERIC PROVIDER
SET PIEN=$PIECE($GET(^VEN(7.5,CFIGIEN,0)),U,13)
+17 WRITE !!,"Preferences will be assigned",!,"to the Default Institutional Provider: ",$PIECE($GET(^VA(200,PIEN,0)),U)
+18 QUIT
End DoDot:1
QUIT PIEN
+19 ; CREATE THE DEPARTMENT'S GENERIC PROVIDER
IF $GET(VENDEPT)
IF '$PIECE($GET(^VEN(7.95,VENDEPT,2)),U,2)
Begin DoDot:1
+20 WRITE !!,"There is no generic provider listed for this clinic/department...",!,"You must enter one now."
+21 DO GP
IF 'PIEN
QUIT
+22 SET DIE="^VEN(7.95,"
SET DA=VENDEPT
SET DR="2.02////"_PIEN
+23 ; ASSIGN THE GENERIC PROVIDER TO THE CLINIC
LOCK +^VEN(7.95,DA):0
IF $TEST
DO ^DIE
LOCK -^VEN(7.95,DA)
+24 QUIT
End DoDot:1
QUIT PIEN
+25 ; USE THE EXISTING DEPARTMENTAL PROVIDER
IF $GET(VENDEPT)
Begin DoDot:1
+26 SET PIEN=$PIECE($GET(^VEN(7.95,VENDEPT,2)),U,2)
IF 'PIEN
QUIT
+27 WRITE !!,"Preferred diagnoses will be assigned to ",$PIECE($GET(^VA(200,PIEN,0)),U)
+28 QUIT
End DoDot:1
QUIT PIEN
+29 ; ASSIGN PREFERENCES TO AN INDIVIDUAL PROVIDER
IF TYPE="P"
IF $GET(VEN("PRV",0))=1
Begin DoDot:1
+30 SET PIEN=$ORDER(VEN("PRV",0))
IF 'PIEN
QUIT
+31 WRITE !!,"Preferred diagnoses will be assigned to ",$PIECE($GET(^VA(200,PIEN,0)),U)
+32 QUIT
End DoDot:1
QUIT PIEN
+33 ; DEFINE PROVIDER GROUP
WRITE !!,"You must assign a generic provider to represent this group of providers..."
+34 DO GP
+35 QUIT PIEN
+36 ;
GP ; EP-GET A GENERIC PROVIDER
+1 WRITE !!,"Enter a name like 'PIMC,PEDIATRICIAN' OR 'CROWNPOINT,FAMILY DOCTOR'"
+2 WRITE !,"You can also enter '??' or a partial name like 'PIMC,'",!,"to see if a suitable name already exists."
+3 WRITE !,"If you are asked to enter INITIALS, just type them in; e.g., 'FDC'."
+4 WRITE !,"If you are asked to enter a mail code, press the return key.",!
+5 SET DIC="^VA(200,"
SET DIC(0)="AEQL"
SET DLAYGO=200
SET DIC("A")="Clinic/department Provider: "
+6 DO ^DIC
IF Y=-1
QUIT
+7 SET PIEN=+Y
+8 WRITE !,"NOTE: In the future, this generic provider can be assigned to other PCC+ forms or clincs",!!
+9 QUIT
+10 ;
NEWLIST ; EP - NEW WAY TO SAVE DX PREFERENCES
+1 NEW NEWDXP,DIC,X,Y,%
+2 WRITE !!
+3 WRITE ?20,"***** WARNING ****"
+4 WRITE !,"This procedure may delete exsiting preferences of selected provider(s)!!!"
+5 WRITE !,"Do you want to proceed"
+6 SET %=""
DO YN^DICN
+7 IF %'=1
DO ^XBFMK
QUIT
+8 SET DIC("A")="Enter the name of the ICD Preference Group: "
SET DIC("B")="PRIMARY"
+9 SET DIC="^VEN(7.33,"
SET DIC(0)="AEQL"
SET DLAYGO=19707.33
+10 DO ^DIC
IF Y=-1
DO ^XBFMK
QUIT
+11 ; STORE THE PREFERENCE GROUP IEN IN NEWDXP
SET NEWDXP=+Y
+12 DO ^XBFMK
+13 DO A
+14 QUIT
+15 ;
