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

VENPCCMG.m

Go to the documentation of this file. 
  1. VENPCCMG ; IHS/OIT/GIS - GLOBAL EDITING OF DIAGNOSES AND ICD CODES ;
  1.  ;;2.6;PCC+;;NOV 12, 2007
  1.  ;
  1.  ;
  1.  ; 
  1. NEW N OLDICD,NEWICD,PROV,NAME,X,DIC,Y,%,%Y,NEWNAR,OLDNAR,PIEN,DO,AICDWD2
  1. INTRO W !!,"GLOBAL CHANGE OF SPECIFIED ICD CODES AND NARRATIVES FOR ONE OR MORE PROVIDERS",!!!
  1. PROV ; GET PROVIDER NAME
  1.  W !,"Enter the name of the provider or '*' for ALL: "
  1.  R NAME:$G(DTIME,60) E  Q
  1.  I NAME?1."^" Q
  1.  I NAME="ALL"!(NAME="all")!(NAME="*") S PROV="ALL" G ICD
  1.  S DIC("S")="I $D(^VEN(7.1,""B"",+$G(Y)))"
  1.  S DIC=200,DIC(0)="EQM",X=NAME D ^DIC K DIC
  1.  I Y=-1 Q
  1.  S PROV=+Y
  1. ICD ; CHANGE ICD CODE
  1.  S DIC="^ICD9(",DIC(0)="AEQM",DIC("A")="Enter the OLD ICD code that you want to change: "
  1.  D ^DIC
  1.  I X="" G NARR
  1.  I Y=-1 Q
  1.  S OLDICD=$P(Y,U,2)
  1.  S DIC("A")="Enter the NEW ICD code that will replace the old one: "
  1.  D ^DIC I Y=-1 Q
  1.  S NEWICD=$P(Y,U,2)
  1. NARR ; CHANGE NARRATIVE
  1.  S DIR(0)="FO^",DIR("A")="Enter the OLD ICD narrative that you want to change" K DA
  1.  D ^DIR K DIR
  1.  I Y="" G RUN
  1.  I $D(DUOUT)!$D(DTOUT)!$D(DIROUT) Q
  1.  S OLDNAR=Y
  1.  S DIR(0)="F^",DIR("A")="Enter the NEW ICD narrative that will replace the old one" K DA
  1.  D ^DIR K DIR
  1.  I $D(DUOUT)!$D(DTOUT)!$D(DIROUT) Q
  1.  S NEWNAR=Y
  1. RUN ; MAKE CHANGES
  1.  W !
  1.  I $L($G(NEWICD)) W !,OLDICD," will be changed to ",NEWICD
  1.  I $L($G(NEWNAR)) W !,OLDNAR," will be changed to ",NEWNAR
  1.  W !,"Is this ok" S %=1 D YN^DICN I %'=1 Q
  1.  W !!,"Making changes..."
  1.  I $G(OLDICD)="",$G(OLDNAR)="" W !,"Request cancelled!" Q
  1.  I $G(NEWFLAG),$G(PROV) D NCHG(PROV) G FIN ; GLOBAL EDIT OF NEW ICD PREF FILE
  1.  I $G(PROV) D CHG(PROV) G FIN
  1.  I $G(NEWFLAG),$G(PROV)="ALL" S PIEN=0 F  S PIEN=$O(^VEN(7.34,"B",PIEN)) Q:'PIEN  D NCHG(PIEN)
  1.  I $G(PROV)="ALL" S PIEN=0 F  S PIEN=$O(^VEN(7.1,"B",PIEN)) Q:'PIEN  D CHG(PIEN)
  1. FIN D ^XBFMK
  1.  W !,"Done!"
  1.  Q
  1.  ; 
  1. CHG(PIEN) ; EP-EDIT THE FILE
  1.  N CIEN,DIK,DA,STG
  1.  S CIEN=0 F  S CIEN=$O(^VEN(7.1,"B",PIEN,CIEN)) Q:'CIEN  S STG=$G(^VEN(7.1,CIEN,0)) I $L(STG) D
  1.  . I $L($G(OLDICD)),OLDICD=$P(STG,U,2) D
  1.  .. S $P(STG,U,2)=NEWICD
  1.  .. K ^VEN(7.1,"AC",OLDICD,CIEN)
  1.  .. S ^VEN(7.1,"AC",NEWICD,CIEN)=""
  1.  .. W "."
  1.  .. Q
  1.  . I $L($G(OLDNAR)),OLDNAR=$P(STG,U,3) S $P(STG,U,3)=NEWNAR W "."
  1.  . S ^VEN(7.1,CIEN,0)=STG
  1.  . Q
  1.  Q
  1.  ; 
  1. NCHG(PIEN) ; EP-GLOBAL EDIT OF EDIT THE NEW ICD PREF FILE
  1.  N CIEN,DIK,DA,STG
  1.  S CIEN=0 F  S CIEN=$O(^VEN(7.34,"B",PIEN,CIEN)) Q:'CIEN  S STG=$G(^VEN(7.34,CIEN,0)) I $L(STG) D
  1.  . I $L($G(OLDICD)),OLDICD=$P(STG,U,4) D
  1.  .. S $P(STG,U,4)=NEWICD
  1.  .. W "."
  1.  .. Q
  1.  . I $L($G(OLDNAR)),OLDNAR=$P(STG,U,3) S $P(STG,U,3)=NEWNAR W "."
  1.  . S ^VEN(7.34,CIEN,0)=STG
  1.  . Q
  1.  Q
  1.  ; 
  1. VUE ; EP-PRINT ALL ICDS AND ASSOCIATED NARRATIVES AND FORMS
  1.  N TMP,CODE,NARR,PIEN,PNAME,IEN,X,TXT,CIEN,CLASS,ICD,IIEN,Y,VENJ,%,%Y,SS,IPC,NPC,Z,I
  1.  S SS=7.1,IPC=2,NPC=3
  1.  I $G(NEWFLAG) S SS=7.34,IPC=4,NPC=3
  1.  W !,"Want to generate a current list of ICD preferences for this site"
  1.  S %=1 D YN^DICN I %'=1 Q
  1.  D WAIT^DICD W !!
  1.  S TMP="^TMP(""VEN GICD"","_$J_")" K @TMP
  1.  S IEN=0,VENJ=$J
  1.  F  S IEN=$O(^VEN(SS,IEN)) Q:'IEN  D  ; BUILD THE ARRAY
  1.  . S X=$G(^VEN(SS,IEN,0)) I '$L(X) Q
  1.  . S PIEN=+X I 'PIEN Q  ; PROVIDER
  1.  . S ICD=$P(X,U,IPC) I '$L(ICD) Q  ; ICD
  1.  . S NARR=$P(X,U,NPC) I '$L(NARR) Q  ; PROVIDER NARRATIVE
  1.  . I '$G(NEWFLAG) S CIEN=$P(X,U,4) I 'CIEN Q  ; CLASS
  1.  . I $G(NEWFLAG) S Z="",CIEN="",Y=$G(^VEN(7.34,IEN,1)) F I=1:2:15 D
  1.  .. S Z=$P(Y,U,I)
  1.  .. I 'Z Q
  1.  .. I CIEN'="" S CIEN=CIEN_","
  1.  .. S CIEN=CIEN_$P("I^^C^^TF^^TM^^F^^M^^SF^^SM",U,I)
  1.  .. Q
  1.  . S IIEN=$$ICD^VENPCCU(ICD) I 'IIEN Q
  1.  . S TXT=$P($G(^ICD9(IIEN,0)),U,3) I '$L(TXT) Q  ; ICD TEXT
  1.  . S @TMP@(ICD,NARR)=TXT_U_PIEN_U_CIEN
  1.  . Q
  1. OUT ; OUTPUT USING %ZIS
  1.  S %ZIS="PM"
  1.  D ^%ZIS
  1.  I POP K DIR,DIRUT,DTOUT,DUOUT,X,Y Q
  1. NOQUE D LIST
  1.  D ^%ZISC
  1.  W !!,"Done!!"
  1.  K DIR,DIRUT,DTOUT,DUOUT,X,Y
  1.  Q
  1.  ; 
  1. LIST ; EP-PRINT ICD LIST
  1.  X ("I $D("_$C(73,79)_")") ; SCREEN VARS MUST EXIST
  1.  E  Q
  1.  I '$G(VENJ) Q  ; MISSING JOB NUMBER
  1.  N TMP,Y,X,ICD,NARR,TXT,LINE,STOP
  1. LINIT S TMP="^TMP(""VEN GICD"","_VENJ_")",LINE=0 X $C(85,32,73,79) ; INITIALIZE THE LIST
  1.  D LINE W "LIST ALL ICD PREFERENCES AND ASSOCIATED PROVIDER NARRATIVE(S)"
  1.  S Y=$G(ZDTTH) I 'Y S Y=$G(DT)
  1.  I Y X ^DD("DD") W "  (",Y,")",!!
  1.  D LINE W "ICD",?7,"ICD NARRATIVE",?35,"PROVIDER NARRATIVE"
  1.  D LINE W "------",?7,"--------------------------",?35,"----------------------------------"
  1.  S ICD="" F  Q:$G(STOP)  S ICD=$O(@TMP@(ICD)) Q:ICD=""  S NARR="" F  S NARR=$O(@TMP@(ICD,NARR)) Q:NARR=""  D  I $G(STOP) Q
  1.  . S X=$G(@TMP@(ICD,NARR)) I '$L(X) Q
  1.  . S TXT=$P(X,U)
  1.  . D LINE W ICD,?7,$E(TXT,1,27),?35,NARR
  1.  . Q
  1.  K @TMP ; CLEANUP
  1.  Q
  1.  ;
  1. LINE ; PAUSE IF NECESSARY
  1.  N X
  1.  W !
  1.  I '$D(IOST) Q
  1.  I $E(IOST,1,2)'="C-" Q
  1.  S LINE=LINE+1
  1.  I LINE'=22 Q
  1.  S LINE=0
  1.  W "<>" R X:$G(DTIME,60) E  Q
  1.  I X?1."^" S STOP=1
  1.  W $C(13),?79,$C(13)
  1.  Q
  1.  ;