Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: VENPCCG

VENPCCG.m

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