TIUPXAP2 ; SLC/JER - More code for the workload capture ;12/4/02@07:54:52 [1/18/05 9:27am]
;;1.0;TEXT INTEGRATION UTILITIES;**20,67,82,107,126,124,149,179,190**;Jun 20, 1997;Build 1
TEST ; Test the PXAPI Data Capture dialogs
N CPT,DFN,ICD,ICDARR,CPTARR,SC,DTOUT,TIU,TIUOK
S DFN=+$$PATIENT^TIULA
S TIU("LOC")=$$SELLOC^TIUVSIT
D GETICD^TIUPXAPI(TIU("LOC"),.ICDARR)
D ICD^TIUPXAPI(.ICD,.ICDARR)
D GETCPT^TIUPXAPC(TIU("LOC"),.CPTARR)
CPTCALL D CPT^TIUPXAPC(.CPT,.CPTARR)
I '$D(CPT),'$D(DTOUT) W !!,$C(7),"You MUST enter one or more Procedures." G CPTCALL
D SCASK^TIUPXAPS(.SC,+DFN,.TIU)
I $D(DTOUT)!(+$O(ICD(0))'>0)&(+$O(CPT(0))'>0)&(+$O(SC(0))'>0) D Q
. W !,$C(7),"Insufficient information for Workload Credit."
. W !,"Missing information will have to be captured by another method."
S TIUOK=$$CONFIRM^TIUPXAPI(.ICD,.CPT,.SC)
I '+TIUOK D G TEST
. W !!,"Changes Discarded. Please Enter Corrected Workload Data..." H 3
. K ICD,CPT,SC,ICDARR,CPTARR
K CPTARR,ICDARR
W "Done."
Q
CMBLST(EMCODES,CPTCODES) ; Combine E/M and other CPT codes
N TIUI,TIUJ,TMPARRY S (TIUI,TIUJ)=0
M TMPARRY=EMCODES S TIUI=EMCODES(0)
F S TIUJ=$O(CPTCODES(TIUJ)) Q:+TIUJ'>0 D
. S TIUI=+$G(TIUI)+1,TMPARRY(TIUI)=CPTCODES(TIUJ),TMPARRY(0)=TIUI
. ;Merge CPT Modifiers
. M TMPARRY(TIUI,"MODIFIER")=CPTCODES(TIUJ,"MODIFIER")
K CPTCODES
M CPTCODES=TMPARRY
Q
PICK(LOW,HIGH,PROMPT,TYPE) ; List selection
N X,Y S PROMPT=$G(PROMPT,"Select Item"),TYPE=$G(TYPE,"LO")
W !
S Y=$$READ^TIUU(TYPE_U_LOW_":"_HIGH,PROMPT)
Q Y
EDTENC(TIUDA,CHNG) ; Edit the encounter for a given note
N TIUD0,TIUD12,TIUDFN,TIUI,TIUVSIT,TIUHL,TIUEDT,TIUPAUSE,TIUERR,TIUWHAT
N TIUCONT,DA
Q:$D(XWBOS)
Q:+$P($G(TIUDPRM(0)),U,14)
D FULL^VALM1
S TIUD0=$G(^TIU(8925,+TIUDA,0)),TIUD12=$G(^(12))
S TIUHL=$P(TIUD12,U,11)
I $P($G(^SC(+TIUHL,0)),U,3)'="C" Q
;
;If not ok to ask workload, quit
I '$$WORKOK^TIUPXAP1(+TIUDA) Q
;
S TIUDFN=$P(TIUD0,U,2),TIUEDT=$P(TIUD0,U,7),TIUVSIT=$P(TIUD0,U,3)
N TIUMVSTF,TIUVSITS
;If no visit has been filed with the document
I $G(TIUVSIT)'>0 D
. ;Check for the visit
. S TIUVSITS=$$GETENC^PXAPI(TIUDFN,TIUEDT,TIUHL)
. I TIUVSITS>0 S TIUVSIT=+TIUVSITS
. ;Set a flag if multiple visits
. I $P(TIUVSITS,U,2)'="" S TIUMVSTF=1
. ;If only one visit update the document
. I $G(TIUVSIT)>0,'$G(TIUMVSTF) D
. . S TIUERR=$$UPDVST(TIUDA,TIUVSIT)
. . K ^TMP("PXKENC",$J)
W !!
;Ask the user if they wish to enter workload if the parameter is defined
;and the multiple visit flag is not set
I $D(TIUDPRM(0)),'$G(TIUMVSTF),$G(TIUVSIT)>0 D Q:'+TIUCONT
. S TIUCONT=$$READ^TIUU("Y","Do you wish to enter workload data at this time","YES")
I $G(VALMAR)="^TMP(""TIUR"",$J)" D
. N TIU D GETTIU^TIULD(.TIU,TIUDA)
. W !!,"For ",$G(TIU("PNM"))," ",$G(TIU("PID"))," Visit on "
. W $P($G(TIU("EDT")),U,2),"...",!
I $P($P(TIUD0,U,7),".")>DT D Q
. W !!,$C(7),"ACRP will not accept data for future Encounters.",!
. W !,"Workload questions won't be asked for this note.",!
. S TIUPAUSE=$$READ^TIUU("EA","Press RETURN to continue...")
I $G(VALMAR)'="^TMP(""TIUR"",$J)" W !!,"Editing Encounter Data...",!
S TIUWHAT=$S($$CHKAPPT(TIUVSIT,TIUDFN,TIUEDT,TIUHL):"INTV",1:"ADDEDIT")
S TIUERR=$$INTV^PXAPI(TIUWHAT,"TIU","TEXT INTEGRATION UTILITIES",.TIUVSIT,$S(+$G(TIUVSIT):"",1:TIUHL),TIUDFN,$S(+$G(TIUVSIT):"",1:TIUEDT))
;
;If an error is returned prompt to continue otherwise if a Visit
;IEN is returned and one is not already defined update the document
I +TIUERR<0 D
. W ! S TIUPAUSE=$$READ^TIUU("EA","Press RETURN to continue...")
ELSE D
. I $G(TIUVSIT)>0,'$P($G(^TIU(8925,+TIUDA,0)),U,3) S TIUERR=$$UPDVST(TIUDA,TIUVSIT)
S CHNG=1
Q
;
CHKVST(TIUDA) ;Check the visit associated with the document for key workload
;data elements. Key data elements include provider, diagnosis,
;procedure and classifications.
; Input -- TIUDA TIU Document file (#8925) IEN
; Output -- 0=No Key Workload Data Elements Exist
; 1=Key Workload Data Elements Exist
; 2=Unable to Determine if Key Workload Data Elements Exist
N I,TIUCHKF,TIUD0,TIUDFN,TIUEDT,TIUHL,TIUVSIT,TIUVSITS,X
;
;Set variables, if the 0th node of the document is not defined quit
S TIUD0=$G(^TIU(8925,+TIUDA,0)) I TIUD0="" S TIUCHKF=2 G CHKVSTQ
S TIUDFN=$P(TIUD0,U,2),TIUVSIT=$P(TIUD0,U,3),TIUEDT=$P(TIUD0,U,7)
S TIUHL=$P($G(^TIU(8925,+TIUDA,12)),U,11)
;
;Get data associated with the visit
I $G(TIUVSIT)>0 D
. D ENCEVENT^PXKENC(TIUVSIT)
ELSE D
. S TIUVSITS=$$GETENC^PXAPI(TIUDFN,TIUEDT,TIUHL)
. I TIUVSITS>0 S TIUVSIT=+TIUVSITS
. I $P(TIUVSITS,U,2)'="" S TIUCHKF=2 ;multiple visits
;
;If a visit is not defined or multiple visits exist, quit
I $G(TIUVSIT)'>0!($G(TIUCHKF)=2) G CHKVSTQ
;
;If a provider or diagnosis or procedure exists for the visit, set flag
;and quit
I $D(^TMP("PXKENC",$J,TIUVSIT,"PRV"))!($D(^("CPT")))!($D(^("POV"))) S TIUCHKF=1 G CHKVSTQ
;
;If a classification exists for the visit, set flag and quit
I $D(^TMP("PXKENC",$J,TIUVSIT,"VST",TIUVSIT,800)) S X=^(800) D
. F I=1:1:6 I $P(X,U,I)'="" S TIUCHKF=1 Q
;
CHKVSTQ K ^TMP("PXKENC",$J)
Q +$G(TIUCHKF)
;
UPDVST(TIUDA,TIUVSIT,ERROR) ;Update Visit in TIU Document file #8925
; Input -- TIUDA TIU Document file (#8925) IEN
; TIUVSIT Visit file (#9000010) IEN
; Output -- 1=Successful and 0=Failure
; ERROR Error Message (Optional)
N DIERR,OKF,TIUFDA
;
;Quit if a visit is not defined
G UPDVSTQ:$G(TIUVSIT)'>0
;
;Update document with visit
S TIUFDA(8925,TIUDA_",",.03)=TIUVSIT
L +^TIU(8925,TIUDA):1 I $T D
. D FILE^DIE("","TIUFDA","") L -^TIU(8925,TIUDA)
. S ERROR=$G(DIERR)
. S OKF=$S(+$G(ERROR):0,1:1)
ELSE D
. S OKF=0
UPDVSTQ Q +$G(OKF)
;
CHKWKL(TIUDA,TIUDPRM) ;Check if workload data should be entered
; Input -- TIUDA TIU Document file (#8925) IEN
; TIUDPRM TIU Document Parameters file (#8925.95) Array
; Output -- 1=Enter Workload and 0=Do Not Enter Workload
N STATUS,TIUAPPTF,TIUD0,TIUDFN,TIUEDT,TIUHL,TIUVSIT,TIUWKLF,TIURES,TIUINC,TIUARRAY,TIUCNT
;
;Set variables, if the 0th node of the document is not defined quit
S TIUD0=$G(^TIU(8925,+TIUDA,0)) G CHKWKLQ:TIUD0=""
S TIUDFN=$P(TIUD0,U,2),TIUVSIT=$P(TIUD0,U,3),TIUEDT=$P(TIUD0,U,7)
S TIUHL=$P($G(^TIU(8925,+TIUDA,12)),U,11)
;
;Check if an appointment is associated with the visit
S:$$CHKAPPT(TIUVSIT,TIUDFN,TIUEDT,TIUHL)>0 TIUAPPTF=1
;
;If an appointment is not associated with the visit, assume
;the visit is new, set flag to enter workload and quit
I '$G(TIUAPPTF) S TIUWKLF=1 G CHKWKLQ
;
;Check the parameter 'Ask Dx/CPT on All Opt Visits'. If it is set to
;No, workload should not be entered for the appointment.
I '$$BROKER^XWBLIB(),'$P($G(TIUDPRM(0)),U,16) G CHKWKLQ
;
;Get the status of the appointment
S TIUARRAY(1)=TIUEDT_";"_TIUEDT
S TIUARRAY(2)=TIUHL
S TIUARRAY(4)=TIUDFN
S TIUARRAY("SORT")="P"
S TIUARRAY("FLDS")="22"
S TIUARRAY("MAX")=1
S TIUCNT=$$SDAPI^SDAMA301(.TIUARRAY)
I TIUCNT=-1 K ^TMP($J,"SDAMA301") Q +$G(TIUWKLF)
S STATUS=+$P($G(^TMP($J,"SDAMA301",TIUDFN,TIUEDT)),U,22)
K ^TMP($J,"SDAMA301")
;Check the status of the appointment. If the appointment can be
;checked-out, workload can be entered.
I $D(^SD(409.63,"ACO",1,STATUS)) S TIUWKLF=1
;
CHKWKLQ Q +$G(TIUWKLF)
;
CHKAPPT(TIUVSIT,TIUDFN,TIUEDT,TIUHL) ;Check if an appointment is associated with the Visit
; Input -- TIUVSIT Visit file (#9000010) IEN
; TIUDFN Patient file (#2) IEN
; TIUEDT Episode Begin Date/Time
; TIUHL Hospital Location file (#44) IEN
; Output -- 0=Appointment is not associated with the Visit
; 1=Appointment is associated with the Visit
N TIUAPPTF
I $G(TIUVSIT),'$$BROKER^XWBLIB() D
. S:$$VST2APPT^PXAPI(TIUVSIT)>0 TIUAPPTF=1
ELSE D
. S:$$APPOINT^PXUTL1(TIUDFN,TIUEDT,TIUHL)>0 TIUAPPTF=1
Q +$G(TIUAPPTF)
TIUPXAP2 ; SLC/JER - More code for the workload capture ;12/4/02@07:54:52 [1/18/05 9:27am]
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**20,67,82,107,126,124,149,179,190**;Jun 20, 1997;Build 1
TEST ; Test the PXAPI Data Capture dialogs
+1 NEW CPT,DFN,ICD,ICDARR,CPTARR,SC,DTOUT,TIU,TIUOK
+2 SET DFN=+$$PATIENT^TIULA
+3 SET TIU("LOC")=$$SELLOC^TIUVSIT
+4 DO GETICD^TIUPXAPI(TIU("LOC"),.ICDARR)
+5 DO ICD^TIUPXAPI(.ICD,.ICDARR)
+6 DO GETCPT^TIUPXAPC(TIU("LOC"),.CPTARR)
CPTCALL DO CPT^TIUPXAPC(.CPT,.CPTARR)
+1 IF '$DATA(CPT)
IF '$DATA(DTOUT)
WRITE !!,$CHAR(7),"You MUST enter one or more Procedures."
GOTO CPTCALL
+2 DO SCASK^TIUPXAPS(.SC,+DFN,.TIU)
+3 IF $DATA(DTOUT)!(+$ORDER(ICD(0))'>0)&(+$ORDER(CPT(0))'>0)&(+$ORDER(SC(0))'>0)
Begin DoDot:1
+4 WRITE !,$CHAR(7),"Insufficient information for Workload Credit."
+5 WRITE !,"Missing information will have to be captured by another method."
End DoDot:1
QUIT
+6 SET TIUOK=$$CONFIRM^TIUPXAPI(.ICD,.CPT,.SC)
+7 IF '+TIUOK
Begin DoDot:1
+8 WRITE !!,"Changes Discarded. Please Enter Corrected Workload Data..."
HANG 3
+9 KILL ICD,CPT,SC,ICDARR,CPTARR
End DoDot:1
GOTO TEST
+10 KILL CPTARR,ICDARR
+11 WRITE "Done."
+12 QUIT
CMBLST(EMCODES,CPTCODES) ; Combine E/M and other CPT codes
+1 NEW TIUI,TIUJ,TMPARRY
SET (TIUI,TIUJ)=0
+2 MERGE TMPARRY=EMCODES
SET TIUI=EMCODES(0)
+3 FOR
SET TIUJ=$ORDER(CPTCODES(TIUJ))
IF +TIUJ'>0
QUIT
Begin DoDot:1
+4 SET TIUI=+$GET(TIUI)+1
SET TMPARRY(TIUI)=CPTCODES(TIUJ)
SET TMPARRY(0)=TIUI
+5 ;Merge CPT Modifiers
+6 MERGE TMPARRY(TIUI,"MODIFIER")=CPTCODES(TIUJ,"MODIFIER")
End DoDot:1
+7 KILL CPTCODES
+8 MERGE CPTCODES=TMPARRY
+9 QUIT
PICK(LOW,HIGH,PROMPT,TYPE) ; List selection
+1 NEW X,Y
SET PROMPT=$GET(PROMPT,"Select Item")
SET TYPE=$GET(TYPE,"LO")
+2 WRITE !
+3 SET Y=$$READ^TIUU(TYPE_U_LOW_":"_HIGH,PROMPT)
+4 QUIT Y
EDTENC(TIUDA,CHNG) ; Edit the encounter for a given note
+1 NEW TIUD0,TIUD12,TIUDFN,TIUI,TIUVSIT,TIUHL,TIUEDT,TIUPAUSE,TIUERR,TIUWHAT
+2 NEW TIUCONT,DA
+3 IF $DATA(XWBOS)
QUIT
+4 IF +$PIECE($GET(TIUDPRM(0)),U,14)
QUIT
+5 DO FULL^VALM1
+6 SET TIUD0=$GET(^TIU(8925,+TIUDA,0))
SET TIUD12=$GET(^(12))
+7 SET TIUHL=$PIECE(TIUD12,U,11)
+8 IF $PIECE($GET(^SC(+TIUHL,0)),U,3)'="C"
QUIT
+9 ;
+10 ;If not ok to ask workload, quit
+11 IF '$$WORKOK^TIUPXAP1(+TIUDA)
QUIT
+12 ;
+13 SET TIUDFN=$PIECE(TIUD0,U,2)
SET TIUEDT=$PIECE(TIUD0,U,7)
SET TIUVSIT=$PIECE(TIUD0,U,3)
+14 NEW TIUMVSTF,TIUVSITS
+15 ;If no visit has been filed with the document
+16 IF $GET(TIUVSIT)'>0
Begin DoDot:1
+17 ;Check for the visit
+18 SET TIUVSITS=$$GETENC^PXAPI(TIUDFN,TIUEDT,TIUHL)
+19 IF TIUVSITS>0
SET TIUVSIT=+TIUVSITS
+20 ;Set a flag if multiple visits
+21 IF $PIECE(TIUVSITS,U,2)'=""
SET TIUMVSTF=1
+22 ;If only one visit update the document
+23 IF $GET(TIUVSIT)>0
IF '$GET(TIUMVSTF)
Begin DoDot:2
+24 SET TIUERR=$$UPDVST(TIUDA,TIUVSIT)
+25 KILL ^TMP("PXKENC",$JOB)
End DoDot:2
End DoDot:1
+26 WRITE !!
+27 ;Ask the user if they wish to enter workload if the parameter is defined
+28 ;and the multiple visit flag is not set
+29 IF $DATA(TIUDPRM(0))
IF '$GET(TIUMVSTF)
IF $GET(TIUVSIT)>0
Begin DoDot:1
+30 SET TIUCONT=$$READ^TIUU("Y","Do you wish to enter workload data at this time","YES")
End DoDot:1
IF '+TIUCONT
QUIT
+31 IF $GET(VALMAR)="^TMP(""TIUR"",$J)"
Begin DoDot:1
+32 NEW TIU
DO GETTIU^TIULD(.TIU,TIUDA)
+33 WRITE !!,"For ",$GET(TIU("PNM"))," ",$GET(TIU("PID"))," Visit on "
+34 WRITE $PIECE($GET(TIU("EDT")),U,2),"...",!
End DoDot:1
+35 IF $PIECE($PIECE(TIUD0,U,7),".")>DT
Begin DoDot:1
+36 WRITE !!,$CHAR(7),"ACRP will not accept data for future Encounters.",!
+37 WRITE !,"Workload questions won't be asked for this note.",!
+38 SET TIUPAUSE=$$READ^TIUU("EA","Press RETURN to continue...")
End DoDot:1
QUIT
+39 IF $GET(VALMAR)'="^TMP(""TIUR"",$J)"
WRITE !!,"Editing Encounter Data...",!
+40 SET TIUWHAT=$SELECT($$CHKAPPT(TIUVSIT,TIUDFN,TIUEDT,TIUHL):"INTV",1:"ADDEDIT")
+41 SET TIUERR=$$INTV^PXAPI(TIUWHAT,"TIU","TEXT INTEGRATION UTILITIES",.TIUVSIT,$SELECT(+$GET(TIUVSIT):"",1:TIUHL),TIUDFN,$SELECT(+$GET(TIUVSIT):"",1:TIUEDT))
+42 ;
+43 ;If an error is returned prompt to continue otherwise if a Visit
+44 ;IEN is returned and one is not already defined update the document
+45 IF +TIUERR<0
Begin DoDot:1
+46 WRITE !
SET TIUPAUSE=$$READ^TIUU("EA","Press RETURN to continue...")
End DoDot:1
+47 IF '$TEST
Begin DoDot:1
+48 IF $GET(TIUVSIT)>0
IF '$PIECE($GET(^TIU(8925,+TIUDA,0)),U,3)
SET TIUERR=$$UPDVST(TIUDA,TIUVSIT)
End DoDot:1
+49 SET CHNG=1
+50 QUIT
+51 ;
CHKVST(TIUDA) ;Check the visit associated with the document for key workload
+1 ;data elements. Key data elements include provider, diagnosis,
+2 ;procedure and classifications.
+3 ; Input -- TIUDA TIU Document file (#8925) IEN
+4 ; Output -- 0=No Key Workload Data Elements Exist
+5 ; 1=Key Workload Data Elements Exist
+6 ; 2=Unable to Determine if Key Workload Data Elements Exist
+7 NEW I,TIUCHKF,TIUD0,TIUDFN,TIUEDT,TIUHL,TIUVSIT,TIUVSITS,X
+8 ;
+9 ;Set variables, if the 0th node of the document is not defined quit
+10 SET TIUD0=$GET(^TIU(8925,+TIUDA,0))
IF TIUD0=""
SET TIUCHKF=2
GOTO CHKVSTQ
+11 SET TIUDFN=$PIECE(TIUD0,U,2)
SET TIUVSIT=$PIECE(TIUD0,U,3)
SET TIUEDT=$PIECE(TIUD0,U,7)
+12 SET TIUHL=$PIECE($GET(^TIU(8925,+TIUDA,12)),U,11)
+13 ;
+14 ;Get data associated with the visit
+15 IF $GET(TIUVSIT)>0
Begin DoDot:1
+16 DO ENCEVENT^PXKENC(TIUVSIT)
End DoDot:1
+17 IF '$TEST
Begin DoDot:1
+18 SET TIUVSITS=$$GETENC^PXAPI(TIUDFN,TIUEDT,TIUHL)
+19 IF TIUVSITS>0
SET TIUVSIT=+TIUVSITS
+20 ;multiple visits
IF $PIECE(TIUVSITS,U,2)'=""
SET TIUCHKF=2
End DoDot:1
+21 ;
+22 ;If a visit is not defined or multiple visits exist, quit
+23 IF $GET(TIUVSIT)'>0!($GET(TIUCHKF)=2)
GOTO CHKVSTQ
+24 ;
+25 ;If a provider or diagnosis or procedure exists for the visit, set flag
+26 ;and quit
+27 IF $DATA(^TMP("PXKENC",$JOB,TIUVSIT,"PRV"))!($DATA(^("CPT")))!($DATA(^("POV")))
SET TIUCHKF=1
GOTO CHKVSTQ
+28 ;
+29 ;If a classification exists for the visit, set flag and quit
+30 IF $DATA(^TMP("PXKENC",$JOB,TIUVSIT,"VST",TIUVSIT,800))
SET X=^(800)
Begin DoDot:1
+31 FOR I=1:1:6
IF $PIECE(X,U,I)'=""
SET TIUCHKF=1
QUIT
End DoDot:1
+32 ;
CHKVSTQ KILL ^TMP("PXKENC",$JOB)
+1 QUIT +$GET(TIUCHKF)
+2 ;
UPDVST(TIUDA,TIUVSIT,ERROR) ;Update Visit in TIU Document file #8925
+1 ; Input -- TIUDA TIU Document file (#8925) IEN
+2 ; TIUVSIT Visit file (#9000010) IEN
+3 ; Output -- 1=Successful and 0=Failure
+4 ; ERROR Error Message (Optional)
+5 NEW DIERR,OKF,TIUFDA
+6 ;
+7 ;Quit if a visit is not defined
+8 IF $GET(TIUVSIT)'>0
GOTO UPDVSTQ
+9 ;
+10 ;Update document with visit
+11 SET TIUFDA(8925,TIUDA_",",.03)=TIUVSIT
+12 LOCK +^TIU(8925,TIUDA):1
IF $TEST
Begin DoDot:1
+13 DO FILE^DIE("","TIUFDA","")
LOCK -^TIU(8925,TIUDA)
+14 SET ERROR=$GET(DIERR)
+15 SET OKF=$SELECT(+$GET(ERROR):0,1:1)
End DoDot:1
+16 IF '$TEST
Begin DoDot:1
+17 SET OKF=0
End DoDot:1
UPDVSTQ QUIT +$GET(OKF)
+1 ;
CHKWKL(TIUDA,TIUDPRM) ;Check if workload data should be entered
+1 ; Input -- TIUDA TIU Document file (#8925) IEN
+2 ; TIUDPRM TIU Document Parameters file (#8925.95) Array
+3 ; Output -- 1=Enter Workload and 0=Do Not Enter Workload
+4 NEW STATUS,TIUAPPTF,TIUD0,TIUDFN,TIUEDT,TIUHL,TIUVSIT,TIUWKLF,TIURES,TIUINC,TIUARRAY,TIUCNT
+5 ;
+6 ;Set variables, if the 0th node of the document is not defined quit
+7 SET TIUD0=$GET(^TIU(8925,+TIUDA,0))
IF TIUD0=""
GOTO CHKWKLQ
+8 SET TIUDFN=$PIECE(TIUD0,U,2)
SET TIUVSIT=$PIECE(TIUD0,U,3)
SET TIUEDT=$PIECE(TIUD0,U,7)
+9 SET TIUHL=$PIECE($GET(^TIU(8925,+TIUDA,12)),U,11)
+10 ;
+11 ;Check if an appointment is associated with the visit
+12 IF $$CHKAPPT(TIUVSIT,TIUDFN,TIUEDT,TIUHL)>0
SET TIUAPPTF=1
+13 ;
+14 ;If an appointment is not associated with the visit, assume
+15 ;the visit is new, set flag to enter workload and quit
+16 IF '$GET(TIUAPPTF)
SET TIUWKLF=1
GOTO CHKWKLQ
+17 ;
+18 ;Check the parameter 'Ask Dx/CPT on All Opt Visits'. If it is set to
+19 ;No, workload should not be entered for the appointment.
+20 IF '$$BROKER^XWBLIB()
IF '$PIECE($GET(TIUDPRM(0)),U,16)
GOTO CHKWKLQ
+21 ;
+22 ;Get the status of the appointment
+23 SET TIUARRAY(1)=TIUEDT_";"_TIUEDT
+24 SET TIUARRAY(2)=TIUHL
+25 SET TIUARRAY(4)=TIUDFN
+26 SET TIUARRAY("SORT")="P"
+27 SET TIUARRAY("FLDS")="22"
+28 SET TIUARRAY("MAX")=1
+29 SET TIUCNT=$$SDAPI^SDAMA301(.TIUARRAY)
+30 IF TIUCNT=-1
KILL ^TMP($JOB,"SDAMA301")
QUIT +$GET(TIUWKLF)
+31 SET STATUS=+$PIECE($GET(^TMP($JOB,"SDAMA301",TIUDFN,TIUEDT)),U,22)
+32 KILL ^TMP($JOB,"SDAMA301")
+33 ;Check the status of the appointment. If the appointment can be
+34 ;checked-out, workload can be entered.
+35 IF $DATA(^SD(409.63,"ACO",1,STATUS))
SET TIUWKLF=1
+36 ;
CHKWKLQ QUIT +$GET(TIUWKLF)
+1 ;
CHKAPPT(TIUVSIT,TIUDFN,TIUEDT,TIUHL) ;Check if an appointment is associated with the Visit
+1 ; Input -- TIUVSIT Visit file (#9000010) IEN
+2 ; TIUDFN Patient file (#2) IEN
+3 ; TIUEDT Episode Begin Date/Time
+4 ; TIUHL Hospital Location file (#44) IEN
+5 ; Output -- 0=Appointment is not associated with the Visit
+6 ; 1=Appointment is associated with the Visit
+7 NEW TIUAPPTF
+8 IF $GET(TIUVSIT)
IF '$$BROKER^XWBLIB()
Begin DoDot:1
+9 IF $$VST2APPT^PXAPI(TIUVSIT)>0
SET TIUAPPTF=1
End DoDot:1
+10 IF '$TEST
Begin DoDot:1
+11 IF $$APPOINT^PXUTL1(TIUDFN,TIUEDT,TIUHL)>0
SET TIUAPPTF=1
End DoDot:1
+12 QUIT +$GET(TIUAPPTF)
