TIUPXAPC ; SLC/JER - Get CPT stuff ;5/8/03@10:27
;;1.0;TEXT INTEGRATION UTILITIES;**15,24,62,82,161**;Jun 20, 1997
TEST ; Check it out
N TIULOC,CPTARR,CPT,TIUI
S TIULOC=+$$SELLOC^TIUVSIT,TIUI=0
D GETCPT(TIULOC,.CPTARR)
D CPT(.CPT,.CPTARR)
W ! F S TIUI=$O(CPT(TIUI)) Q:+TIUI'>0 D
. W !,"CPT(",TIUI,")=",CPT(TIUI),!,"CPT(",TIUI,",""QTY"")="
. W CPT(TIUI,"QTY")
Q
; Pass encounter date from TIUPXAPI to IBDF18A **161**
GETCPT(TIULOC,CPTARR,TIUVDT) ; Get CPT codes for clinic
N TIUI,TIUROW,TIUCOL,ARRY2,TIUITM,TIUPAGE,EMARRY,TIUCAT S TIUCAT=""
; Pass encounter date as 5th parameter to IBDF18A **161**
D GETLST^IBDF18A(+TIULOC,"DG SELECT VISIT TYPE CPT PROCEDURES","EMARRY",,,1,TIUVDT)
D GETLST^IBDF18A(+TIULOC,"DG SELECT CPT PROCEDURE CODES","ARRY2",,,1,TIUVDT)
I $D(EMARRY)>9 D CMBLST^TIUPXAP2(.EMARRY,.ARRY2) K EMARRY
S (TIUI,TIUROW,TIUITM)=0,(TIUCOL,TIUPAGE)=1
F S TIUI=$O(ARRY2(TIUI)) Q:+TIUI'>0 D
. I $P(ARRY2(TIUI),U)]"" D I 1
. . S TIUROW=+$G(TIUROW)+1,TIUITM=+$G(TIUITM)+1
. . ;Set CPT Display Array: Item #^CPT Code^Description^Group
. . S CPTARR(TIUROW,TIUCOL)=TIUITM_U_$P($G(ARRY2(TIUI)),U,1,2)_U_TIUCAT
. . S CPTARR("INDEX",TIUITM)=$P($G(ARRY2(TIUI)),U,1,2)_U_TIUCAT
. . ;If pre-selected CPT Modifiers are defined, add them to CPT Display Array
. . ;Pass encounter date to ADDMOD call to pass to ICPTMOD for CSV *161
. . I +$G(ARRY2(TIUI,"MODIFIER",0))>0 D ADDMOD(TIUITM,TIUI,.CPTARR,.ARRY2,.TIUROW,.TIUCOL,.TIUPAGE,TIUVDT)
. . K ARRY2(TIUI)
. E D
. . S TIUROW=+$G(TIUROW)+1
. . S TIUCAT=$$UP^XLFSTR($P($G(ARRY2(TIUI)),U,2))
. . S CPTARR(TIUROW,TIUCOL)=U_U_TIUCAT
. . K ARRY2(TIUI)
. ;Update counters for CPT Display Array
. D UPDCNT(.TIUROW,.TIUCOL,.TIUPAGE)
I +$G(ARRY2(0))>0 D
. S TIUROW=+$G(TIUROW)+1,TIUITM=TIUITM+1
. S CPTARR(TIUROW,TIUCOL)=TIUITM_"^OTHER CPT^OTHER Procedure"
. S CPTARR("INDEX",TIUITM)="OTHER CPT^OTHER Procedure"
. S CPTARR(0)=+$G(ARRY2(0))_U_+$G(TIUROW)_U_+$G(TIUPAGE)
. ;Update counters for CPT Display Array
. D UPDCNT(.TIUROW,.TIUCOL,.TIUPAGE)
Q
;
UPDCNT(TIUROW,TIUCOL,TIUPAGE) ;Update Counters for CPT Display Array
; Input -- TIUROW Row Counter
; TIUCOL Column Counter
; TIUPAGE Page Counter
; Output -- Counters:
; TIUROW Row Counter
; TIUCOL Column Counter
; TIUPAGE Page Counter
I TIUROW#20'>0 D
. S:TIUCOL=3 TIUPAGE=TIUPAGE+1
. S TIUCOL=$S(TIUCOL=3:1,1:TIUCOL+1)
. S TIUROW=20*(TIUPAGE-1)
Q
;
;Pass in encounter date to pass to ICPTMOD,TIUPXAPM for CSV **161**
ADDMOD(TIUITM,TIUI,CPTARR,ARRY2,TIUROW,TIUCOL,TIUPAGE,TIUVDT) ;Add Pre-selected CPT Modifiers from AICS to CPT Display Array
; Input -- TIUITM Item Number in CPT Display Array
; TIUI Item Number in Combined AICS Selection List Array
; CPTARR CPT Display Array
; ARRY2 Combined AICS Selection List Array
; TIUROW Row Counter
; TIUCOL Column Counter
; TIUPAGE Page Counter
; Output -- CPTARR CPT Display Array
; (TIUROW,TIUCOL)=
; ^^^^CPT Modifier^CPT Modifier Name
; ("INDEX",TIUITM,"MODIFIER",MODCNT)=
; CPT Modifier IEN^CPT Modifier^CPT Modifier Name
; TIUROW Row Counter
; TIUCOL Column Counter
; TIUPAGE Page Counter
; TIUVDT Encounter Date
N MODCNT,MODIFIER,MODINFO
;
;Loop through pre-selected CPT Modifiers
S MODCNT=0
F S MODCNT=$O(ARRY2(TIUI,"MODIFIER",MODCNT)) Q:'MODCNT D
. S MODIFIER=$P(ARRY2(TIUI,"MODIFIER",MODCNT),U) Q:MODIFIER=""
. ;Invoke API to get CPT Modifier information
. ;Pass encounter date to ICPTMOD for CSV **161**
. S MODINFO=$$MOD^ICPTMOD(MODIFIER,,TIUVDT)
. I +MODINFO>0 D
. . S TIUROW=TIUROW+1
. . ;Set CPT Modifier and CPT Modifier Name into CPT Display Array
. . S CPTARR(TIUROW,TIUCOL)=U_U_U_U_$P(MODINFO,U,2,3)
. . ;Set CPT Modifier IEN, CPT Modifier and CPT Modifier Name into Index for CPT Display Array
. . S CPTARR("INDEX",TIUITM,"MODIFIER",MODCNT)=$P(MODINFO,U,1,3)
Q
;
;Pass encounter date to CPT to pass to ICPTCOD
CPT(CPT,CPTARR,TIUVDT) ; Select Procedures
N I,J,L,Y,TIUCPT,TIUICNT,TIUPGS,TIUPG,TIUITM,TIULITM,TIUPNM
S TIUPNM=$S($L($G(TIU("PNM"))):$G(TIU("PNM")),+$G(DFN):$$PTNAME^TIULC1(DFN),1:"the Patient")
W !!,"Please Indicate the Procedure(s) Performed on "_TIUPNM_":"
W:+$O(CPTARR(0)) !
S TIUICNT=+$G(CPTARR(0)),TIUPGS=$P($G(CPTARR(0)),U,3)
S (I,J,L,Y)=0 I +TIUICNT S TIUPG=1
F S I=$O(CPTARR(I)) Q:+I'>0 D
. S J=0 W ! F S J=$O(CPTARR(I,J)) Q:+J'>0 D
. . W ?((J-1)*25) W:+$P(CPTARR(I,J),U) $J($P(CPTARR(I,J),U),2)_" " W $E($P(CPTARR(I,J),U,3),1,20)
. . ;Display pre-selected CPT Modifier
. . W:$P(CPTARR(I,J),U,5)'="" " -"_$P(CPTARR(I,J),U,5)_" "_$E($P(CPTARR(I,J),U,6),1,14)
. . S TIUITM=$S(+$G(CPTARR(I,J)):+$G(CPTARR(I,J)),1:$G(TIUITM))
. . S:TIUITM>+$G(TIULITM) TIULITM=TIUITM
. I I#20=0 S Y=$S(+Y:Y,1:"")_$P($$PICK^TIUPXAP2(1,+$G(TIULITM),"Select Procedures"_$S(+$G(TIUPG)<TIUPGS:" (<RETURN> to see next page of choices)",1:"")),U),TIUPG=+$G(TIUPG)+1 W !
. S L=I S:TIUITM>+$G(TIULITM) TIULITM=TIUITM
I L#20 S Y=$S(+Y:Y,1:"")_$P($$PICK^TIUPXAP2(1,TIULITM,"Select Procedures"),U)
I +Y,$P(CPTARR("INDEX",+Y),U)'="OTHER CPT" D I 1
. N I,ITEM F I=1:1:($L(Y,",")-1) D
. . S ITEM=$P(Y,",",I)
. . I $P(CPTARR("INDEX",+ITEM),U)'="OTHER CPT" D I 1
. . . S CPT(I)=$G(CPTARR("INDEX",+ITEM))
. . . S $P(CPT(I),U,4)=$P(CPT(I),U)
. . . ;Pass encounter date to CPT to pass to ICDTCOD for CSV **161**
. . . S $P(CPT(I),U)=+$$CPT^ICPTCOD($P(CPT(I),U),TIUVDT)
. . . I +CPT(I)'>0 D
. . . . K CPT(I)
. . . ELSE D
. . . . ;Merge pre-selected CPT Modifiers from CPT Display Array into CPT Selection Array
. . . . M CPT(I,"MOD")=CPTARR("INDEX",ITEM,"MODIFIER")
. . ;Pass encounter date to CPTOUT for CSV **161**
. . E D CPTOUT(.CPT,.I,TIUVDT)
E D CPTOUT(.CPT,,TIUVDT)
I +$O(CPT(1)) D I 1
. N TIUI S TIUI=0
. F S TIUI=$O(CPT(TIUI)) Q:+TIUI'>0 D
. . S CPT(TIUI,"QTY")=+$$QTY(.CPT,TIUI)
. . K:CPT(TIUI,"QTY")'>0 CPT(TIUI)
. . ;Select CPT Modifiers
. . ;Pass encounter date to TIUPXAPM to pass to ICPTCOD for CVS **161**
. . I $D(CPT(TIUI)) D MOD^TIUPXAPM(.CPT,TIUI,TIUVDT)
E I $D(CPT(1)) D
. S CPT(1,"QTY")=+$$QTY(.CPT,1)
. K:CPT(1,"QTY")'>0 CPT(1)
. ;Select CPT Modifiers
. ;Pass encounter date to TIUPXAPM to pass to ICPTCOD for CSV **161**
. I $D(CPT(1)) D MOD^TIUPXAPM(.CPT,1,TIUVDT)
Q
QTY(CPT,TIUI) ; How many times was the procedure performed?
N PROMPT,HELP
S PROMPT="How many times was the procedure performed? "
S HELP="^D QTYHLP^TIUPXAPC"
W !!!,$$UP^XLFSTR($P(CPT(TIUI),U,2)),":",!
Q +$$READ^TIUU("NA^1:99",PROMPT,1,HELP)
QTYHLP ; Help for QTY read
W !,"Please specify the number of repetitions for this procedure"
W !,"performed during this visit with the patient (1-99)."
Q
; Pass in encounter date to pass to LEXSET for CSV **161**
CPTOUT(CPT,TIUI,TIUVDT) ; Go off-list for Procedure(s)
N DIC,X,Y,TIUOUT
F D Q:+$G(TIUOUT)
. I $L($T(CONFIG^LEXSET)) D I 1
. .; Pass encounter date to LEXSET for CSV **161**
. . D CONFIG^LEXSET("CHP","CHP",TIUVDT) ; PCH 24
. E S DIC="^ICPT("
. S DIC(0)="AEMQ"
. S DIC("A")="Select "_$S(+$G(CPTARR(0))'>0:"Procedure: ",1:"Another Procedure"_$S($D(CPTARR):" (NOT from Above List)",1:"")_": ")
. N X
. D ^DIC
. I +$D(DTOUT)!+$D(DUOUT)!(X="") S TIUOUT=1 Q
. I +Y>0 D Q
. . ; Pass encounter date to LEXC to LEXSET for CSV **161**
. . I DIC="^LEX(757.01," S Y=$$LEXC(Y,TIUVDT) ; PCH 24
. . S:$S(+$G(TIUI)'>0:1,$D(CPT(+$G(TIUI))):1,1:0) TIUI=$G(TIUI)+1
. . S CPT(TIUI)=Y
. W $C(7),!!,"Nothing found for ",X,"..."
. F D Q:(+Y>0)!+$G(TIUOUT)
. . N X
. . I $L($T(CONFIG^LEXSET)) D I 1
. . .; Pass encounter date for CSV **161**
. . . D CONFIG^LEXSET("CHP","CHP",TIUVDT) ; PCH 24
. . E S DIC="^ICPT("
. . S DIC("A")="Please try another expression, or RETURN to continue: "
. . D ^DIC
. . I +$D(DTOUT)!+$D(DUOUT)!(X="") S TIUOUT=1 Q
. . I +Y>0 D Q
. . . ; Pass encounter date to LEXC for CSV **161**
. . . I DIC="^LEX(757.01," S Y=$$LEXC(Y,TIUVDT) ; PCH 24
. . . S:$S(+$G(TIUI)'>0:1,$D(CPT(+$G(TIUI))):1,1:0) TIUI=$G(TIUI)+1
. . . S CPT(TIUI)=Y
. . W $C(7),!!,"Nothing found for ",X,"..."
Q
; Pass in encounter date for CSV **161**
LEXC(Y,TIUVDT) ; Get CPT IEN from Lexicon returned code PCH 24
N TIUC,TIUCODE S Y=$G(Y)
; Pass encounter date for CSV **161**
S TIUC=$$CPTONE^LEXU(+Y,TIUVDT) S:'$L(TIUC) TIUC=$$CPCONE^LEXU(+Y,TIUVDT)
I '$L(TIUC) S Y="-1"_U_$P(Y,U,2) Q Y
S TIUCODE=TIUC
; Pass encounter date instead of current date to ICPTCOD for CSV **161**
S TIUC=+$$CPT^ICPTCOD(TIUCODE,TIUVDT) S Y=TIUC_U_$P(Y,U,2)
S Y=Y_"^^"_TIUCODE
Q Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUPXAPC 8873 printed Apr 09, 2024@21:44:33 Page 2
TIUPXAPC ; SLC/JER - Get CPT stuff ;5/8/03@10:27
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**15,24,62,82,161**;Jun 20, 1997
TEST ; Check it out
+1 NEW TIULOC,CPTARR,CPT,TIUI
+2 SET TIULOC=+$$SELLOC^TIUVSIT
SET TIUI=0
+3 DO GETCPT(TIULOC,.CPTARR)
+4 DO CPT(.CPT,.CPTARR)
+5 WRITE !
FOR
SET TIUI=$ORDER(CPT(TIUI))
if +TIUI'>0
QUIT
Begin DoDot:1
+6 WRITE !,"CPT(",TIUI,")=",CPT(TIUI),!,"CPT(",TIUI,",""QTY"")="
+7 WRITE CPT(TIUI,"QTY")
End DoDot:1
+8 QUIT
+9 ; Pass encounter date from TIUPXAPI to IBDF18A **161**
GETCPT(TIULOC,CPTARR,TIUVDT) ; Get CPT codes for clinic
+1 NEW TIUI,TIUROW,TIUCOL,ARRY2,TIUITM,TIUPAGE,EMARRY,TIUCAT
SET TIUCAT=""
+2 ; Pass encounter date as 5th parameter to IBDF18A **161**
+3 DO GETLST^IBDF18A(+TIULOC,"DG SELECT VISIT TYPE CPT PROCEDURES","EMARRY",,,1,TIUVDT)
+4 DO GETLST^IBDF18A(+TIULOC,"DG SELECT CPT PROCEDURE CODES","ARRY2",,,1,TIUVDT)
+5 IF $DATA(EMARRY)>9
DO CMBLST^TIUPXAP2(.EMARRY,.ARRY2)
KILL EMARRY
+6 SET (TIUI,TIUROW,TIUITM)=0
SET (TIUCOL,TIUPAGE)=1
+7 FOR
SET TIUI=$ORDER(ARRY2(TIUI))
if +TIUI'>0
QUIT
Begin DoDot:1
+8 IF $PIECE(ARRY2(TIUI),U)]""
Begin DoDot:2
+9 SET TIUROW=+$GET(TIUROW)+1
SET TIUITM=+$GET(TIUITM)+1
+10 ;Set CPT Display Array: Item #^CPT Code^Description^Group
+11 SET CPTARR(TIUROW,TIUCOL)=TIUITM_U_$PIECE($GET(ARRY2(TIUI)),U,1,2)_U_TIUCAT
+12 SET CPTARR("INDEX",TIUITM)=$PIECE($GET(ARRY2(TIUI)),U,1,2)_U_TIUCAT
+13 ;If pre-selected CPT Modifiers are defined, add them to CPT Display Array
+14 ;Pass encounter date to ADDMOD call to pass to ICPTMOD for CSV *161
+15 IF +$GET(ARRY2(TIUI,"MODIFIER",0))>0
DO ADDMOD(TIUITM,TIUI,.CPTARR,.ARRY2,.TIUROW,.TIUCOL,.TIUPAGE,TIUVDT)
+16 KILL ARRY2(TIUI)
End DoDot:2
IF 1
+17 IF '$TEST
Begin DoDot:2
+18 SET TIUROW=+$GET(TIUROW)+1
+19 SET TIUCAT=$$UP^XLFSTR($PIECE($GET(ARRY2(TIUI)),U,2))
+20 SET CPTARR(TIUROW,TIUCOL)=U_U_TIUCAT
+21 KILL ARRY2(TIUI)
End DoDot:2
+22 ;Update counters for CPT Display Array
+23 DO UPDCNT(.TIUROW,.TIUCOL,.TIUPAGE)
End DoDot:1
+24 IF +$GET(ARRY2(0))>0
Begin DoDot:1
+25 SET TIUROW=+$GET(TIUROW)+1
SET TIUITM=TIUITM+1
+26 SET CPTARR(TIUROW,TIUCOL)=TIUITM_"^OTHER CPT^OTHER Procedure"
+27 SET CPTARR("INDEX",TIUITM)="OTHER CPT^OTHER Procedure"
+28 SET CPTARR(0)=+$GET(ARRY2(0))_U_+$GET(TIUROW)_U_+$GET(TIUPAGE)
+29 ;Update counters for CPT Display Array
+30 DO UPDCNT(.TIUROW,.TIUCOL,.TIUPAGE)
End DoDot:1
+31 QUIT
+32 ;
UPDCNT(TIUROW,TIUCOL,TIUPAGE) ;Update Counters for CPT Display Array
+1 ; Input -- TIUROW Row Counter
+2 ; TIUCOL Column Counter
+3 ; TIUPAGE Page Counter
+4 ; Output -- Counters:
+5 ; TIUROW Row Counter
+6 ; TIUCOL Column Counter
+7 ; TIUPAGE Page Counter
+8 IF TIUROW#20'>0
Begin DoDot:1
+9 if TIUCOL=3
SET TIUPAGE=TIUPAGE+1
+10 SET TIUCOL=$SELECT(TIUCOL=3:1,1:TIUCOL+1)
+11 SET TIUROW=20*(TIUPAGE-1)
End DoDot:1
+12 QUIT
+13 ;
+14 ;Pass in encounter date to pass to ICPTMOD,TIUPXAPM for CSV **161**
ADDMOD(TIUITM,TIUI,CPTARR,ARRY2,TIUROW,TIUCOL,TIUPAGE,TIUVDT) ;Add Pre-selected CPT Modifiers from AICS to CPT Display Array
+1 ; Input -- TIUITM Item Number in CPT Display Array
+2 ; TIUI Item Number in Combined AICS Selection List Array
+3 ; CPTARR CPT Display Array
+4 ; ARRY2 Combined AICS Selection List Array
+5 ; TIUROW Row Counter
+6 ; TIUCOL Column Counter
+7 ; TIUPAGE Page Counter
+8 ; Output -- CPTARR CPT Display Array
+9 ; (TIUROW,TIUCOL)=
+10 ; ^^^^CPT Modifier^CPT Modifier Name
+11 ; ("INDEX",TIUITM,"MODIFIER",MODCNT)=
+12 ; CPT Modifier IEN^CPT Modifier^CPT Modifier Name
+13 ; TIUROW Row Counter
+14 ; TIUCOL Column Counter
+15 ; TIUPAGE Page Counter
+16 ; TIUVDT Encounter Date
+17 NEW MODCNT,MODIFIER,MODINFO
+18 ;
+19 ;Loop through pre-selected CPT Modifiers
+20 SET MODCNT=0
+21 FOR
SET MODCNT=$ORDER(ARRY2(TIUI,"MODIFIER",MODCNT))
if 'MODCNT
QUIT
Begin DoDot:1
+22 SET MODIFIER=$PIECE(ARRY2(TIUI,"MODIFIER",MODCNT),U)
if MODIFIER=""
QUIT
+23 ;Invoke API to get CPT Modifier information
+24 ;Pass encounter date to ICPTMOD for CSV **161**
+25 SET MODINFO=$$MOD^ICPTMOD(MODIFIER,,TIUVDT)
+26 IF +MODINFO>0
Begin DoDot:2
+27 SET TIUROW=TIUROW+1
+28 ;Set CPT Modifier and CPT Modifier Name into CPT Display Array
+29 SET CPTARR(TIUROW,TIUCOL)=U_U_U_U_$PIECE(MODINFO,U,2,3)
+30 ;Set CPT Modifier IEN, CPT Modifier and CPT Modifier Name into Index for CPT Display Array
+31 SET CPTARR("INDEX",TIUITM,"MODIFIER",MODCNT)=$PIECE(MODINFO,U,1,3)
End DoDot:2
End DoDot:1
+32 QUIT
+33 ;
+34 ;Pass encounter date to CPT to pass to ICPTCOD
CPT(CPT,CPTARR,TIUVDT) ; Select Procedures
+1 NEW I,J,L,Y,TIUCPT,TIUICNT,TIUPGS,TIUPG,TIUITM,TIULITM,TIUPNM
+2 SET TIUPNM=$SELECT($LENGTH($GET(TIU("PNM"))):$GET(TIU("PNM")),+$GET(DFN):$$PTNAME^TIULC1(DFN),1:"the Patient")
+3 WRITE !!,"Please Indicate the Procedure(s) Performed on "_TIUPNM_":"
+4 if +$ORDER(CPTARR(0))
WRITE !
+5 SET TIUICNT=+$GET(CPTARR(0))
SET TIUPGS=$PIECE($GET(CPTARR(0)),U,3)
+6 SET (I,J,L,Y)=0
IF +TIUICNT
SET TIUPG=1
+7 FOR
SET I=$ORDER(CPTARR(I))
if +I'>0
QUIT
Begin DoDot:1
+8 SET J=0
WRITE !
FOR
SET J=$ORDER(CPTARR(I,J))
if +J'>0
QUIT
Begin DoDot:2
+9 WRITE ?((J-1)*25)
if +$PIECE(CPTARR(I,J),U)
WRITE $JUSTIFY($PIECE(CPTARR(I,J),U),2)_" "
WRITE $EXTRACT($PIECE(CPTARR(I,J),U,3),1,20)
+10 ;Display pre-selected CPT Modifier
+11 if $PIECE(CPTARR(I,J),U,5)'=""
WRITE " -"_$PIECE(CPTARR(I,J),U,5)_" "_$EXTRACT($PIECE(CPTARR(I,J),U,6),1,14)
+12 SET TIUITM=$SELECT(+$GET(CPTARR(I,J)):+$GET(CPTARR(I,J)),1:$GET(TIUITM))
+13 if TIUITM>+$GET(TIULITM)
SET TIULITM=TIUITM
End DoDot:2
+14 IF I#20=0
SET Y=$SELECT(+Y:Y,1:"")_$PIECE($$PICK^TIUPXAP2(1,+$GET(TIULITM),"Select Procedures"_$SELECT(+$GET(TIUPG)<TIUPGS:" (<RETURN> to see next page of choices)",1:"")),U)
SET TIUPG=+$GET(TIUPG)+1
WRITE !
+15 SET L=I
if TIUITM>+$GET(TIULITM)
SET TIULITM=TIUITM
End DoDot:1
+16 IF L#20
SET Y=$SELECT(+Y:Y,1:"")_$PIECE($$PICK^TIUPXAP2(1,TIULITM,"Select Procedures"),U)
+17 IF +Y
IF $PIECE(CPTARR("INDEX",+Y),U)'="OTHER CPT"
Begin DoDot:1
+18 NEW I,ITEM
FOR I=1:1:($LENGTH(Y,",")-1)
Begin DoDot:2
+19 SET ITEM=$PIECE(Y,",",I)
+20 IF $PIECE(CPTARR("INDEX",+ITEM),U)'="OTHER CPT"
Begin DoDot:3
+21 SET CPT(I)=$GET(CPTARR("INDEX",+ITEM))
+22 SET $PIECE(CPT(I),U,4)=$PIECE(CPT(I),U)
+23 ;Pass encounter date to CPT to pass to ICDTCOD for CSV **161**
+24 SET $PIECE(CPT(I),U)=+$$CPT^ICPTCOD($PIECE(CPT(I),U),TIUVDT)
+25 IF +CPT(I)'>0
Begin DoDot:4
+26 KILL CPT(I)
End DoDot:4
+27 IF '$TEST
Begin DoDot:4
+28 ;Merge pre-selected CPT Modifiers from CPT Display Array into CPT Selection Array
+29 MERGE CPT(I,"MOD")=CPTARR("INDEX",ITEM,"MODIFIER")
End DoDot:4
End DoDot:3
IF 1
+30 ;Pass encounter date to CPTOUT for CSV **161**
+31 IF '$TEST
DO CPTOUT(.CPT,.I,TIUVDT)
End DoDot:2
End DoDot:1
IF 1
+32 IF '$TEST
DO CPTOUT(.CPT,,TIUVDT)
+33 IF +$ORDER(CPT(1))
Begin DoDot:1
+34 NEW TIUI
SET TIUI=0
+35 FOR
SET TIUI=$ORDER(CPT(TIUI))
if +TIUI'>0
QUIT
Begin DoDot:2
+36 SET CPT(TIUI,"QTY")=+$$QTY(.CPT,TIUI)
+37 if CPT(TIUI,"QTY")'>0
KILL CPT(TIUI)
+38 ;Select CPT Modifiers
+39 ;Pass encounter date to TIUPXAPM to pass to ICPTCOD for CVS **161**
+40 IF $DATA(CPT(TIUI))
DO MOD^TIUPXAPM(.CPT,TIUI,TIUVDT)
End DoDot:2
End DoDot:1
IF 1
+41 IF '$TEST
IF $DATA(CPT(1))
Begin DoDot:1
+42 SET CPT(1,"QTY")=+$$QTY(.CPT,1)
+43 if CPT(1,"QTY")'>0
KILL CPT(1)
+44 ;Select CPT Modifiers
+45 ;Pass encounter date to TIUPXAPM to pass to ICPTCOD for CSV **161**
+46 IF $DATA(CPT(1))
DO MOD^TIUPXAPM(.CPT,1,TIUVDT)
End DoDot:1
+47 QUIT
QTY(CPT,TIUI) ; How many times was the procedure performed?
+1 NEW PROMPT,HELP
+2 SET PROMPT="How many times was the procedure performed? "
+3 SET HELP="^D QTYHLP^TIUPXAPC"
+4 WRITE !!!,$$UP^XLFSTR($PIECE(CPT(TIUI),U,2)),":",!
+5 QUIT +$$READ^TIUU("NA^1:99",PROMPT,1,HELP)
QTYHLP ; Help for QTY read
+1 WRITE !,"Please specify the number of repetitions for this procedure"
+2 WRITE !,"performed during this visit with the patient (1-99)."
+3 QUIT
+4 ; Pass in encounter date to pass to LEXSET for CSV **161**
CPTOUT(CPT,TIUI,TIUVDT) ; Go off-list for Procedure(s)
+1 NEW DIC,X,Y,TIUOUT
+2 FOR
Begin DoDot:1
+3 IF $LENGTH($TEXT(CONFIG^LEXSET))
Begin DoDot:2
+4 ; Pass encounter date to LEXSET for CSV **161**
+5 ; PCH 24
DO CONFIG^LEXSET("CHP","CHP",TIUVDT)
End DoDot:2
IF 1
+6 IF '$TEST
SET DIC="^ICPT("
+7 SET DIC(0)="AEMQ"
+8 SET DIC("A")="Select "_$SELECT(+$GET(CPTARR(0))'>0:"Procedure: ",1:"Another Procedure"_$SELECT($DATA(CPTARR):" (NOT from Above List)",1:"")_": ")
+9 NEW X
+10 DO ^DIC
+11 IF +$DATA(DTOUT)!+$DATA(DUOUT)!(X="")
SET TIUOUT=1
QUIT
+12 IF +Y>0
Begin DoDot:2
+13 ; Pass encounter date to LEXC to LEXSET for CSV **161**
+14 ; PCH 24
IF DIC="^LEX(757.01,"
SET Y=$$LEXC(Y,TIUVDT)
+15 if $SELECT(+$GET(TIUI)'>0
SET TIUI=$GET(TIUI)+1
+16 SET CPT(TIUI)=Y
End DoDot:2
QUIT
+17 WRITE $CHAR(7),!!,"Nothing found for ",X,"..."
+18 FOR
Begin DoDot:2
+19 NEW X
+20 IF $LENGTH($TEXT(CONFIG^LEXSET))
Begin DoDot:3
+21 ; Pass encounter date for CSV **161**
+22 ; PCH 24
DO CONFIG^LEXSET("CHP","CHP",TIUVDT)
End DoDot:3
IF 1
+23 IF '$TEST
SET DIC="^ICPT("
+24 SET DIC("A")="Please try another expression, or RETURN to continue: "
+25 DO ^DIC
+26 IF +$DATA(DTOUT)!+$DATA(DUOUT)!(X="")
SET TIUOUT=1
QUIT
+27 IF +Y>0
Begin DoDot:3
+28 ; Pass encounter date to LEXC for CSV **161**
+29 ; PCH 24
IF DIC="^LEX(757.01,"
SET Y=$$LEXC(Y,TIUVDT)
+30 if $SELECT(+$GET(TIUI)'>0
SET TIUI=$GET(TIUI)+1
+31 SET CPT(TIUI)=Y
End DoDot:3
QUIT
+32 WRITE $CHAR(7),!!,"Nothing found for ",X,"..."
End DoDot:2
if (+Y>0)!+$GET(TIUOUT)
QUIT
End DoDot:1
if +$GET(TIUOUT)
QUIT
+33 QUIT
+34 ; Pass in encounter date for CSV **161**
LEXC(Y,TIUVDT) ; Get CPT IEN from Lexicon returned code PCH 24
+1 NEW TIUC,TIUCODE
SET Y=$GET(Y)
+2 ; Pass encounter date for CSV **161**
+3 SET TIUC=$$CPTONE^LEXU(+Y,TIUVDT)
if '$LENGTH(TIUC)
SET TIUC=$$CPCONE^LEXU(+Y,TIUVDT)
+4 IF '$LENGTH(TIUC)
SET Y="-1"_U_$PIECE(Y,U,2)
QUIT Y
+5 SET TIUCODE=TIUC
+6 ; Pass encounter date instead of current date to ICPTCOD for CSV **161**
+7 SET TIUC=+$$CPT^ICPTCOD(TIUCODE,TIUVDT)
SET Y=TIUC_U_$PIECE(Y,U,2)
+8 SET Y=Y_"^^"_TIUCODE
+9 QUIT Y
