- 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)
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUPXAP2 8006 printed Feb 19, 2025@00:11:13 Page 2
- 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)