| [613] | 1 | TIUPXAPI ; SLC/JER - Interface w/PCE/Visit Tracking ;5/8/03@10:26
|
|---|
| 2 | ;;1.0;TEXT INTEGRATION UTILITIES;**15,24,29,82,107,126,161**;Jun 20, 1997
|
|---|
| 3 | CREDIT(DFN,TIU,VSIT) ; Get Dx, CPT, (& SC) for the CMD's mandate
|
|---|
| 4 | N CPT,ICD,ICDARR,CPTARR,SC,DTOUT,TIUOK,TIUPRLST
|
|---|
| 5 | ; For Historical Visits, just QUEUE the PXAPI call and quit
|
|---|
| 6 | I $P(TIU("VSTR"),";",3)="E" D QUE^TIUPXAP1 Q
|
|---|
| 7 | ; If no Location, and not Historical Visit, then quit
|
|---|
| 8 | Q:+$G(TIU("VSTR"))'>0
|
|---|
| 9 | REENTER I $G(VALMAR)="^TMP(""TIUR"",$J)",$D(TIU("PNM")) D
|
|---|
| 10 | . W !!,"For ",$G(TIU("PNM"))," ",$G(TIU("PID"))," Visit on "
|
|---|
| 11 | . W $P($G(TIU("EDT")),U,2),"..."
|
|---|
| 12 | D PROVLIST(.TIUPRLST)
|
|---|
| 13 | N TIUVDT S TIUVDT=$P($G(TIU("VSTR")),";",2)
|
|---|
| 14 | ; *161 Pass encounter date to GETICD as 3rd and 4th variable, then to IBDF18A
|
|---|
| 15 | D GETICD(TIU("LOC"),.ICDARR,TIUVDT)
|
|---|
| 16 | ICDCALL D ICD(.ICD,.ICDARR,TIUVDT) G:+$G(DTOUT) INSUFF ; **15**
|
|---|
| 17 | I '$D(ICD),'$D(DTOUT) W !!,$C(7),"You MUST enter one or more Diagnoses." H 3 G ICDCALL
|
|---|
| 18 | K ICDARR ; **15**
|
|---|
| 19 | ; Pass encounter date to TIUPXAPC to pass to IBDF18A **161**
|
|---|
| 20 | D GETCPT^TIUPXAPC(TIU("LOC"),.CPTARR,TIUVDT)
|
|---|
| 21 | ; Pass encounter date to TIUPXAPC,ICPTCOD,TIUPXAPM for CSV **161**
|
|---|
| 22 | CPTCALL D CPT^TIUPXAPC(.CPT,.CPTARR,TIUVDT) G:+$G(DTOUT) INSUFF
|
|---|
| 23 | I '$D(CPT),'$D(DTOUT) W !!,$C(7),"You MUST enter one or more Procedures." H 3 G CPTCALL
|
|---|
| 24 | K CPTARR ; **15**
|
|---|
| 25 | D SCASK^TIUPXAPS(.SC,+DFN,.TIU)
|
|---|
| 26 | INSUFF I $D(DTOUT)!(+$O(ICD(0))'>0)&(+$O(CPT(0))'>0)&(+$O(SC(0))'>0) D G POST
|
|---|
| 27 | . W !,$C(7),"Insufficient information for Workload Credit."
|
|---|
| 28 | . W !,"Missing information will have to be captured by another method."
|
|---|
| 29 | S TIUOK=$$CONFIRM(.ICD,.CPT,.SC)
|
|---|
| 30 | I '+TIUOK D G REENTER
|
|---|
| 31 | . W !!,"Changes Discarded. Please Enter Corrected Workload Data..." H 3
|
|---|
| 32 | . K ICD,CPT,SC,ICDARR,CPTARR
|
|---|
| 33 | K CPTARR,ICDARR
|
|---|
| 34 | W !!,"Posting Workload Credit..."
|
|---|
| 35 | POST D QUE^TIUPXAP1 ; Queue TIU/PXAPI RESOURCE
|
|---|
| 36 | W:'+$G(DTOUT) "Done."
|
|---|
| 37 | Q
|
|---|
| 38 | CONFIRM(ICD,CPT,SC) ; Show user and confirm
|
|---|
| 39 | N TIUI,TIUY S TIUY=0
|
|---|
| 40 | W !!,"You have indicated the following data apply to this visit:",!
|
|---|
| 41 | W !,"DIAGNOSES:"
|
|---|
| 42 | S TIUI=0
|
|---|
| 43 | F S TIUI=$O(ICD(TIUI)) Q:+TIUI'>0 D
|
|---|
| 44 | . W !?3,$P(ICD(TIUI),U,2),?12,$E($P(ICD(TIUI),U,3),1,67)
|
|---|
| 45 | . W:+$G(ICD(TIUI,"PRIMARY")) " <<< PRIMARY"
|
|---|
| 46 | W !!,"PROCEDURES:"
|
|---|
| 47 | S TIUI=0
|
|---|
| 48 | F S TIUI=$O(CPT(TIUI)) Q:+TIUI'>0 D
|
|---|
| 49 | . W !?3,$P(CPT(TIUI),U,4),?12,$E($P(CPT(TIUI),U,2),1,67)
|
|---|
| 50 | . ;Display CPT Modifiers
|
|---|
| 51 | . D DISMOD^TIUPXAPM(.CPT,TIUI)
|
|---|
| 52 | I $D(SC)>9 D
|
|---|
| 53 | . W !!,"SERVICE CONNECTION:"
|
|---|
| 54 | . W !?3,"Service Connected? ",$S(+$G(SC("SC")):"YES",1:"NO")
|
|---|
| 55 | . I $D(SC("AO")),+$G(SC("SC"))'>0 W !?3,"Agent Orange? ",$S($G(SC("AO"))]"":$P($G(SC("AO")),U,2),1:"NOT ANSWERED")
|
|---|
| 56 | . I $D(SC("IR")),+$G(SC("SC"))'>0 W !?3,"Ionizing Radiation? ",$S($G(SC("IR"))]"":$P($G(SC("IR")),U,2),1:"NOT ANSWERED")
|
|---|
| 57 | . I $D(SC("EC")),+$G(SC("SC"))'>0 W !?3,"Environmental Contaminants? ",$S($G(SC("EC"))]"":$P($G(SC("EC")),U,2),1:"NOT ANSWERED")
|
|---|
| 58 | . I $D(SC("MST")) W !?3,"MST? ",$S($G(SC("MST"))]"":$P($G(SC("MST")),U,2),1:"NOT ANSWERED")
|
|---|
| 59 | . I $D(SC("HNC")) W !?3,"Head and/or Neck Cancer? ",$S($G(SC("HNC"))]"":$P($G(SC("HNC")),U,2),1:"NOT ANSWERED")
|
|---|
| 60 | W ! S TIUY=+$$READ^TIUU("Y"," ...OK","YES")
|
|---|
| 61 | Q +$G(TIUY)
|
|---|
| 62 | ; Pass encounter date to GETICD to pass to IBDF18A **161**
|
|---|
| 63 | GETICD(TIULOC,ICDARR,TIUVDT) ; Get ICD-9 codes for clinic
|
|---|
| 64 | N TIUI,TIUROW,TIUCOL,ARRY2,TIUITM,TIUPAGE,TIUCAT S TIUCAT=""
|
|---|
| 65 | ; Pass encounter date as the 5th parameter to IBDF18A **161**
|
|---|
| 66 | D GETLST^IBDF18A(+TIULOC,"DG SELECT ICD-9 DIAGNOSIS CODES","ARRY2",,,,TIUVDT)
|
|---|
| 67 | S (TIUI,TIUROW,TIUITM)=0,(TIUCOL,TIUPAGE)=1
|
|---|
| 68 | F S TIUI=$O(ARRY2(TIUI)) Q:+TIUI'>0 D
|
|---|
| 69 | . I $P(ARRY2(TIUI),U)]"" D I 1
|
|---|
| 70 | . . S TIUROW=+$G(TIUROW)+1,TIUITM=+$G(TIUITM)+1
|
|---|
| 71 | . . S ICDARR(TIUROW,TIUCOL)=TIUITM_U_$G(ARRY2(TIUI))_U_TIUCAT
|
|---|
| 72 | . . S ICDARR("INDEX",TIUITM)=$G(ARRY2(TIUI))_U_TIUCAT K ARRY2(TIUI)
|
|---|
| 73 | . E D
|
|---|
| 74 | . . S TIUROW=+$G(TIUROW)+1,TIUCAT=$$UP^XLFSTR($P($G(ARRY2(TIUI)),U,2))
|
|---|
| 75 | . . S ICDARR(TIUROW,TIUCOL)=U_U_TIUCAT
|
|---|
| 76 | . . K ARRY2(TIUI)
|
|---|
| 77 | . I (TIUROW#20'>0),(TIUCOL=3) S TIUPAGE=TIUPAGE+1
|
|---|
| 78 | . I TIUROW#20'>0 S TIUCOL=$S(TIUCOL=3:1,1:TIUCOL+1),TIUROW=20*(TIUPAGE-1)
|
|---|
| 79 | I +$G(ARRY2(0))>0 D
|
|---|
| 80 | . S TIUROW=+$G(TIUROW)+1,TIUITM=TIUITM+1
|
|---|
| 81 | . S ICDARR(TIUROW,TIUCOL)=TIUITM_"^OTHER ICD^OTHER Diagnosis"
|
|---|
| 82 | . S ICDARR("INDEX",TIUITM)="OTHER ICD^OTHER Diagnosis"
|
|---|
| 83 | . S ICDARR(0)=+$G(ARRY2(0))_U_+$G(TIUROW)_U_+$G(TIUPAGE)
|
|---|
| 84 | . I (TIUROW#20'>0),(TIUCOL=3) S TIUPAGE=TIUPAGE+1
|
|---|
| 85 | . I TIUROW#20'>0 S TIUCOL=$S(TIUCOL=3:1,1:TIUCOL+1),TIUROW=20*(TIUPAGE-1)
|
|---|
| 86 | Q
|
|---|
| 87 | ; Pass encounter date as TIUVDT for CSV **161**
|
|---|
| 88 | ICD(ICD,ICDARR,TIUVDT) ; Select Dx's
|
|---|
| 89 | N I,J,Y,TIUICD,TIUICNT,TIUPGS,TIUPG,TIUITM,TIULITM,TIUPNM
|
|---|
| 90 | S TIUPNM=$S($L($G(TIU("PNM"))):$G(TIU("PNM")),+$G(DFN):$$PTNAME^TIULC1(DFN),1:"the Patient")
|
|---|
| 91 | W !!,"Please Indicate the Diagnoses for which "_TIUPNM_" was Seen:"
|
|---|
| 92 | W:+$O(ICDARR(0)) !
|
|---|
| 93 | S TIUICNT=+$G(ICDARR(0)),TIUPGS=$P($G(ICDARR(0)),U,3)
|
|---|
| 94 | S (I,J,L,Y)=0 I +TIUICNT S TIUPG=1
|
|---|
| 95 | F S I=$O(ICDARR(I)) Q:+I'>0 D Q:+$G(DTOUT)
|
|---|
| 96 | . S J=0 W ! F S J=$O(ICDARR(I,J)) Q:+J'>0 D
|
|---|
| 97 | . . W ?((J-1)*25) W:+$P(ICDARR(I,J),U) $J($P(ICDARR(I,J),U),2)_" " W $E($P(ICDARR(I,J),U,3),1,20)
|
|---|
| 98 | . . S TIUITM=$S(+$G(ICDARR(I,J)):+$G(ICDARR(I,J)),1:$G(TIUITM))
|
|---|
| 99 | . . S:TIUITM>+$G(TIULITM) TIULITM=TIUITM
|
|---|
| 100 | . I I#20=0 S Y=$S(+Y:Y,1:"")_$P($$PICK^TIUPXAP2(1,+$G(TIULITM),"Select Diagnoses"_$S(+$G(TIUPG)<TIUPGS:" (<RETURN> to see next page of choices)",1:"")),U),TIUPG=+$G(TIUPG)+1 W !
|
|---|
| 101 | . S L=I S:TIUITM>+$G(TIULITM) TIULITM=TIUITM
|
|---|
| 102 | I +$G(DTOUT) Q
|
|---|
| 103 | I L#20 S Y=$S(+Y:Y,1:"")_$P($$PICK^TIUPXAP2(1,TIULITM,"Select Diagnoses"),U)
|
|---|
| 104 | I +Y,$P(ICDARR("INDEX",+Y),U)'="OTHER ICD" D I 1
|
|---|
| 105 | . N I,ITEM F I=1:1:($L(Y,",")-1) D Q:+$G(DTOUT)
|
|---|
| 106 | . . S ITEM=$P(Y,",",I)
|
|---|
| 107 | . . I $P(ICDARR("INDEX",+ITEM),U)'="OTHER ICD" D
|
|---|
| 108 | . . . S TIUICD=+$O(^ICD9("AB",$P(ICDARR("INDEX",+ITEM),U)_" ",0))
|
|---|
| 109 | . . . S ICD(I)=TIUICD_U_$G(ICDARR("INDEX",+ITEM))
|
|---|
| 110 | . . ; Pass encounter date to ICDOUT to pass to LEXSET for CSV **161**
|
|---|
| 111 | . . E D ICDOUT(.ICD,.I,TIUVDT)
|
|---|
| 112 | Q:+$G(DTOUT)
|
|---|
| 113 | ; Pass encounter date to ICDOUT to pass to LEXSET for CSV **161**
|
|---|
| 114 | E D ICDOUT(.ICD,,TIUVDT)
|
|---|
| 115 | I +$O(ICD(1)) D ASKPRMRY(.ICD) I 1
|
|---|
| 116 | Q:+$G(DTOUT)
|
|---|
| 117 | E I $D(ICD(1)) S ICD(1,"PRIMARY")=1
|
|---|
| 118 | Q
|
|---|
| 119 | ASKPRMRY(ICD) ; Which Dx is Primary
|
|---|
| 120 | N I,L,Y
|
|---|
| 121 | PRMAGN W !!,"Please indicate which of the Diagnoses is the Primary Diagnosis:",!
|
|---|
| 122 | S (I,L,Y)=0 F S I=$O(ICD(I)) Q:+I'>0!+Y D
|
|---|
| 123 | . W:$P(ICD(I),U)]"" !,I,?7,$P(ICD(I),U,3)
|
|---|
| 124 | . I I#20=0 S Y=$P($$PICK^TIUPXAP2(1,I,"Select Diagnosis","NO"),U)
|
|---|
| 125 | . S L=I
|
|---|
| 126 | I L#20,'+Y S Y=$P($$PICK^TIUPXAP2(1,L,"Select Diagnosis","NO"),U)
|
|---|
| 127 | I +Y'>0 W !!?3,$C(7),"You must specify a Primary Diagnosis." G PRMAGN
|
|---|
| 128 | I +Y,$D(ICD(+Y)) S ICD(+Y,"PRIMARY")=1
|
|---|
| 129 | Q
|
|---|
| 130 | ICDOUT(ICD,TIUI,TIUVDT) ; Go off-list for Dx
|
|---|
| 131 | N DIC,X,Y,TIUICD,TIUOUT
|
|---|
| 132 | F D Q:+$G(TIUOUT)
|
|---|
| 133 | . I $L($T(CONFIG^LEXSET)) D I 1
|
|---|
| 134 | . . ; Pass encounter date to LEXSET for CSV **161**
|
|---|
| 135 | . . D CONFIG^LEXSET("ICD","ICD",TIUVDT)
|
|---|
| 136 | . E D Q
|
|---|
| 137 | . . W !,$C(7),"You must install LEXICON UTILITY v2.0 for this function to work...Contact IRM.",!
|
|---|
| 138 | . . I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
|
|---|
| 139 | . . S TIUOUT=1
|
|---|
| 140 | . S DIC(0)="AEMQ"
|
|---|
| 141 | . S DIC("A")="Select "_$S(+$G(ICDARR(0))'>0:"Diagnosis: ",1:"Another Diagnosis"_$S($D(ICDARR):" (NOT from Above List)",1:"")_": ")
|
|---|
| 142 | . N X K DIC("B")
|
|---|
| 143 | . D ^DIC
|
|---|
| 144 | . I +$D(DTOUT)!+$D(DUOUT)!(X="") S TIUOUT=1 Q
|
|---|
| 145 | . I $G(Y(1))]"" D Q
|
|---|
| 146 | . . S TIUICD=+$O(^ICD9("AB",$P(Y(1),U)_" ",0))
|
|---|
| 147 | . . S:TIUICD'>0 TIUICD=+$O(^ICD9("AB",$P(Y(1),U)_"0 ",0))
|
|---|
| 148 | . . I +TIUICD'>0 W !,$C(7),"ICD CODE NOT FOUND FOR EXPRESSION." Q
|
|---|
| 149 | . . S:$S(+$G(TIUI)'>0:1,$D(ICD(+$G(TIUI))):1,1:0) TIUI=$G(TIUI)+1
|
|---|
| 150 | . . S ICD(TIUI)=TIUICD_U_Y(1)_U_$P(Y,U,2)
|
|---|
| 151 | . W $C(7),!!,"Nothing found for ",X,"..."
|
|---|
| 152 | . F D Q:(+Y>0)!+$G(TIUOUT)
|
|---|
| 153 | . . N X
|
|---|
| 154 | . . I $L($T(CONFIG^LEXSET)) D I 1
|
|---|
| 155 | . . . ; Pass encounter date to LEXSET for CSV **161**
|
|---|
| 156 | . . . D CONFIG^LEXSET("ICD","ICD",TIUVDT)
|
|---|
| 157 | . . E D Q
|
|---|
| 158 | . . . W !,$C(7),"You must install LEXICON UTILITY v2.0 for this function to work...Contact IRM.",!
|
|---|
| 159 | . . . I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
|
|---|
| 160 | . . . S TIUOUT=1
|
|---|
| 161 | . . S DIC("A")="Please try another expression, or RETURN to continue: "
|
|---|
| 162 | . . D ^DIC
|
|---|
| 163 | . . I +$D(DTOUT)!+$D(DUOUT)!(X="") S TIUOUT=1 Q
|
|---|
| 164 | . . I +$G(Y(1))>0 D Q
|
|---|
| 165 | . . . S TIUICD=+$O(^ICD9("AB",$P(Y(1),U)_" ",0))
|
|---|
| 166 | . . . S:$S(+$G(TIUI)'>0:1,$D(ICD(+$G(TIUI))):1,1:0) TIUI=$G(TIUI)+1
|
|---|
| 167 | . . . S ICD(TIUI)=TIUICD_U_Y(1)_U_$P(Y,U,2)
|
|---|
| 168 | . . W $C(7),!!,"Nothing found for ",X,"..."
|
|---|
| 169 | Q
|
|---|
| 170 | PROVLIST(PROVLIST) ; Identify primary provider
|
|---|
| 171 | N PRIMARY,DFLT,DUOUT S DFLT=""
|
|---|
| 172 | W !
|
|---|
| 173 | I +$P($G(TIUPRM0),U,8)=0 Q
|
|---|
| 174 | I +$P($G(TIUPRM0),U,8)=1 S DFLT=$$DFLTDOC(+TIU("VLOC"))
|
|---|
| 175 | I +DFLT=DUZ S PROVLIST(1,"NAME")=DUZ,PROVLIST(1,"PRIMARY")=1 Q
|
|---|
| 176 | I +DFLT S DFLT=$P(DFLT,U,2)
|
|---|
| 177 | S:DFLT']"" DFLT=$S($$PROVIDER^TIUPXAP1(DUZ,DT):$$PERSNAME^TIULC1(DUZ),1:"")
|
|---|
| 178 | ASKPR S PRIMARY=+$$ASKDOC(DFLT)
|
|---|
| 179 | I +PRIMARY'>0 Q
|
|---|
| 180 | I '+$$PROVIDER^TIUPXAP1(PRIMARY,DT) D G ASKPR
|
|---|
| 181 | . W !,$C(7)," Selected user is not a known PROVIDER. Please choose another..."
|
|---|
| 182 | S PROVLIST(1,"NAME")=DUZ
|
|---|
| 183 | I PRIMARY=DUZ S PROVLIST(1,"PRIMARY")=1
|
|---|
| 184 | E S PROVLIST(2,"NAME")=PRIMARY,PROVLIST(2,"PRIMARY")=1,PROVLIST(1,"PRIMARY")=0
|
|---|
| 185 | Q
|
|---|
| 186 | ASKDOC(DFLT) ; Call ^DIC to look-up provider
|
|---|
| 187 | N DIC,X,Y
|
|---|
| 188 | S DIC=200,DIC(0)="AEMQ",DIC("A")="Select PRIMARY PROVIDER: "
|
|---|
| 189 | I $G(DFLT)]"" S DIC("B")=$G(DFLT)
|
|---|
| 190 | D ^DIC
|
|---|
| 191 | Q +Y
|
|---|
| 192 | DFLTDOC(HLOC) ; Get the default Provider
|
|---|
| 193 | N PXBPMT,TIUPNM,Y S Y=""
|
|---|
| 194 | D PRV^PXBUTL2(HLOC)
|
|---|
| 195 | I $D(PXBPMT("DEF")) S TIUPNM=$O(PXBPMT("DEF","")),Y=$O(PXBPMT("DEF",TIUPNM,0))_U_TIUPNM
|
|---|
| 196 | Q Y
|
|---|
