- 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 Feb 19, 2025@00:11:15 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