TIUCNFIX ; SLC/MAM - Resolve Upload Filing Errors for Consults ;05/06/02
;;1.0;TEXT INTEGRATION UTILITIES;**131**;Jun 20, 1997
CNFIX ; Consults Filing Error Resolution Code
; Requires: TIUEVNT - 8925.4 Upload Log Event IEN
; Requires: TIUTYPE - IEN of Docmt Def whose Filing Error
; Resolution Code is being invoked.
; Taken from alert or filing error.
;Modeled on PNFIX^TIUPNFIX, with optional change to PN added
;
N TIUFLDS,TIUBUF,SUCCESS,OLDTYPE,DFN,TITLDA,TIU
S SUCCESS=0
I '$D(^TIU(8925.1,+$G(TIUTYPE),0)) S SUCCESS="0^Document type is missing or invalid." G CNFIXX
I '$D(^TIU(8925.4,+$G(TIUEVNT),0)) S SUCCESS="0^Upload Log event is missing or invalid." G CNFIXX
S TIUBUF=$$BUFFER^TIUFIX2(TIUEVNT) I +TIUBUF'>0 S SUCCESS=TIUBUF G CNFIXX
I '$D(TIUPRM0) D SETPARM^TIULE ; Sets TIUPRM0 with hdr signal, etc
; -- Load hdr data from buffer into array TIUFLDS:
D LOADHDR^TIUFIX2(.TIUFLDS,TIUBUF,TIUPRM0,TIUTYPE)
; -- Get from user all data needed to create a new document
; of the given type. Cross-check user data for consistency.
S OLDTYPE=TIUTYPE
D GETCHECK(.SUCCESS,.TIUTYPE,.TIUFLDS,.DFN,.TITLDA,.TIU)
; -- If all is NOT in order to create a consult,
; and type is still consults, exit w/o creating docmt:
I 'SUCCESS,TIUTYPE=OLDTYPE G CNFIXX
; -- If user chose to create a progress note instead
; of a consult, kill REQUESTING PACKAGE node of array
; and get progress note title:
I TIUTYPE'=OLDTYPE D G:'SUCCESS CNFIXX
. K TIUFLDS(1405)
. ; -- Get progress notes title
. ; (Screen out consult titles)
. ; (Don't ASK if user wants to change to PN;
. ; user is already changing to PN):
. S BADTYPES=+$$CLASS^TIUCNSLT,ASK=0
. W !!," OK, changing document to a progress note..."
. D GETTITLE^TIUFIX(.SUCCESS,.TIUTYPE,.TIUFLDS,.TITLDA,BADTYPES,ASK)
; -- If all is in order to create a consult,
; or if type has changed to progress note,
; then continue and create consult/progress note,
; file fields remaining in TIUFLDS, execute post-file code, etc.:
D MAKE^TIUFIX1(.SUCCESS,TIUEVNT,TIUBUF,.TIUTYPE,.TIUFLDS,.DFN,.TITLDA,.TIU,TIUPRM0)
; -- If docmt filed successfully, set flag to stop - don't go
; on and try to resolve error by editing buffer and refiling.
CNFIXX I +SUCCESS S TIUDONE=1
; -- If error successfully resolved, and type changed,
; update type in event log entry:
I $G(TIUDONE),TIUTYPE'=OLDTYPE D
. N DIE,DR,DA,TYPE
. S TYPE="PROGRESS NOTES"
. S DIE=8925.4,DR=".03////"_TYPE,DA=+TIUEVNT
. D ^DIE
Q:$G(TIUDONE)
W !!,"Filing error could not be resolved."
I $P(SUCCESS,U,2)]"" W !,$P(SUCCESS,U,2)
W !,"If you wish to try a different approach, edit the buffered data directly",!,"and refile it, or simply exit and try again later.",!
Q
;
GETCHECK(SUCCESS,TIUTYPE,TIUFLDS,DFN,TITLDA,TIU) ; Get and check data
; Get from user: Patient, Visit, Document Title, Consult
;Request Number. Check that data are consistent. Reset Request
;Number into array TIUFLDS. Ask user if they want to change
;document type to Progress Note.
;Modeled on GETCHECK^TIUPNFIX, with optional change to PN added
; -- Get patient and visit
PAT S DFN=+$$PATIENT^TIULA
N TIUCNNBR,CHANGEPT,ASK,BADTYPES
S SUCCESS="0^Patient and Visit are Required."
Q:DFN'>0
D ENPN^TIUVSIT(.TIU,+DFN,1)
I '$D(TIU) Q
I '$$CHEKPN^TIUCHLP(.TIU) K TIU Q
; -- Get title
; (No need to limit title beyond
; making sure it has type TIUTYPE.)
; (ASK if user wants to change to PN):
S BADTYPES="",ASK=1
D GETTITLE^TIUFIX(.SUCCESS,.TIUTYPE,.TIUFLDS,.TITLDA,BADTYPES,ASK)
; -- If user didn't select title or wants to change to
; Progress Note, quit:
I TITLDA'>0 Q
I TIUTYPE=3 Q
; -- Get consult request:
D GETCNSLT(.SUCCESS,.TIUTYPE,.TIUFLDS,.CHANGEPT,.TIUCNNBR)
I $G(CHANGEPT) G PAT
I TIUCNNBR'>0 Q
; -- We now have a valid request number, consistent with DFN.
; Transform Consult Request # into form C.# and reset
; request node:
S TIUCNNBR=$P(TIUCNNBR,";") ; was #;GMR(123,
S TIUFLDS(1405)=$$TRNSFRM^TIUPEFIX(TIUTYPE,1405,TIUCNNBR)
S SUCCESS=1
Q
;
GETCNSLT(SUCCESS,TIUTYPE,TIUFLDS,CHANGEPT,TIUCNNBR) ; Get consult
;request from user
N CLINPROC,TIUOVR,DOCNUM,Y
S SUCCESS="0^Consult Request is Required."
S CLINPROC=0,TIUOVR=1,DOCNUM=0 ;Don't have a docmt yet
S TIUCNNBR=$$GETCNSLT^TIUCNSLT(DFN,CLINPROC,DOCNUM,TIUOVR)
; -- Pt has no requests:
I +TIUCNNBR=-1 D Q
. W !!,"This patient has no consult requests; please make sure you have the"
. W !,"correct patient."
. S Y=$$READ^TIUU("YO"," Want to change the patient","YES")
. I Y S CHANGEPT=1 Q
. I $D(DIRUT) Q
. ; -- Ask user if want to change to PN:
. S Y=$$ASKCHNG^TIUFIX(2,.TIUTYPE)
; -- User did not select request:
I +TIUCNNBR=0 D
. W !!,"To upload into a consult title, you must select a request."
. S Y=$$ASKCHNG^TIUFIX(2,.TIUTYPE)
Q
;
TIUCNFIX ; SLC/MAM - Resolve Upload Filing Errors for Consults ;05/06/02
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**131**;Jun 20, 1997
CNFIX ; Consults Filing Error Resolution Code
+1 ; Requires: TIUEVNT - 8925.4 Upload Log Event IEN
+2 ; Requires: TIUTYPE - IEN of Docmt Def whose Filing Error
+3 ; Resolution Code is being invoked.
+4 ; Taken from alert or filing error.
+5 ;Modeled on PNFIX^TIUPNFIX, with optional change to PN added
+6 ;
+7 NEW TIUFLDS,TIUBUF,SUCCESS,OLDTYPE,DFN,TITLDA,TIU
+8 SET SUCCESS=0
+9 IF '$DATA(^TIU(8925.1,+$GET(TIUTYPE),0))
SET SUCCESS="0^Document type is missing or invalid."
GOTO CNFIXX
+10 IF '$DATA(^TIU(8925.4,+$GET(TIUEVNT),0))
SET SUCCESS="0^Upload Log event is missing or invalid."
GOTO CNFIXX
+11 SET TIUBUF=$$BUFFER^TIUFIX2(TIUEVNT)
IF +TIUBUF'>0
SET SUCCESS=TIUBUF
GOTO CNFIXX
+12 ; Sets TIUPRM0 with hdr signal, etc
IF '$DATA(TIUPRM0)
DO SETPARM^TIULE
+13 ; -- Load hdr data from buffer into array TIUFLDS:
+14 DO LOADHDR^TIUFIX2(.TIUFLDS,TIUBUF,TIUPRM0,TIUTYPE)
+15 ; -- Get from user all data needed to create a new document
+16 ; of the given type. Cross-check user data for consistency.
+17 SET OLDTYPE=TIUTYPE
+18 DO GETCHECK(.SUCCESS,.TIUTYPE,.TIUFLDS,.DFN,.TITLDA,.TIU)
+19 ; -- If all is NOT in order to create a consult,
+20 ; and type is still consults, exit w/o creating docmt:
+21 IF 'SUCCESS
IF TIUTYPE=OLDTYPE
GOTO CNFIXX
+22 ; -- If user chose to create a progress note instead
+23 ; of a consult, kill REQUESTING PACKAGE node of array
+24 ; and get progress note title:
+25 IF TIUTYPE'=OLDTYPE
Begin DoDot:1
+26 KILL TIUFLDS(1405)
+27 ; -- Get progress notes title
+28 ; (Screen out consult titles)
+29 ; (Don't ASK if user wants to change to PN;
+30 ; user is already changing to PN):
+31 SET BADTYPES=+$$CLASS^TIUCNSLT
SET ASK=0
+32 WRITE !!," OK, changing document to a progress note..."
+33 DO GETTITLE^TIUFIX(.SUCCESS,.TIUTYPE,.TIUFLDS,.TITLDA,BADTYPES,ASK)
End DoDot:1
IF 'SUCCESS
GOTO CNFIXX
+34 ; -- If all is in order to create a consult,
+35 ; or if type has changed to progress note,
+36 ; then continue and create consult/progress note,
+37 ; file fields remaining in TIUFLDS, execute post-file code, etc.:
+38 DO MAKE^TIUFIX1(.SUCCESS,TIUEVNT,TIUBUF,.TIUTYPE,.TIUFLDS,.DFN,.TITLDA,.TIU,TIUPRM0)
+39 ; -- If docmt filed successfully, set flag to stop - don't go
+40 ; on and try to resolve error by editing buffer and refiling.
CNFIXX IF +SUCCESS
SET TIUDONE=1
+1 ; -- If error successfully resolved, and type changed,
+2 ; update type in event log entry:
+3 IF $GET(TIUDONE)
IF TIUTYPE'=OLDTYPE
Begin DoDot:1
+4 NEW DIE,DR,DA,TYPE
+5 SET TYPE="PROGRESS NOTES"
+6 SET DIE=8925.4
SET DR=".03////"_TYPE
SET DA=+TIUEVNT
+7 DO ^DIE
End DoDot:1
+8 IF $GET(TIUDONE)
QUIT
+9 WRITE !!,"Filing error could not be resolved."
+10 IF $PIECE(SUCCESS,U,2)]""
WRITE !,$PIECE(SUCCESS,U,2)
+11 WRITE !,"If you wish to try a different approach, edit the buffered data directly",!,"and refile it, or simply exit and try again later.",!
+12 QUIT
+13 ;
GETCHECK(SUCCESS,TIUTYPE,TIUFLDS,DFN,TITLDA,TIU) ; Get and check data
+1 ; Get from user: Patient, Visit, Document Title, Consult
+2 ;Request Number. Check that data are consistent. Reset Request
+3 ;Number into array TIUFLDS. Ask user if they want to change
+4 ;document type to Progress Note.
+5 ;Modeled on GETCHECK^TIUPNFIX, with optional change to PN added
+6 ; -- Get patient and visit
PAT SET DFN=+$$PATIENT^TIULA
+1 NEW TIUCNNBR,CHANGEPT,ASK,BADTYPES
+2 SET SUCCESS="0^Patient and Visit are Required."
+3 IF DFN'>0
QUIT
+4 DO ENPN^TIUVSIT(.TIU,+DFN,1)
+5 IF '$DATA(TIU)
QUIT
+6 IF '$$CHEKPN^TIUCHLP(.TIU)
KILL TIU
QUIT
+7 ; -- Get title
+8 ; (No need to limit title beyond
+9 ; making sure it has type TIUTYPE.)
+10 ; (ASK if user wants to change to PN):
+11 SET BADTYPES=""
SET ASK=1
+12 DO GETTITLE^TIUFIX(.SUCCESS,.TIUTYPE,.TIUFLDS,.TITLDA,BADTYPES,ASK)
+13 ; -- If user didn't select title or wants to change to
+14 ; Progress Note, quit:
+15 IF TITLDA'>0
QUIT
+16 IF TIUTYPE=3
QUIT
+17 ; -- Get consult request:
+18 DO GETCNSLT(.SUCCESS,.TIUTYPE,.TIUFLDS,.CHANGEPT,.TIUCNNBR)
+19 IF $GET(CHANGEPT)
GOTO PAT
+20 IF TIUCNNBR'>0
QUIT
+21 ; -- We now have a valid request number, consistent with DFN.
+22 ; Transform Consult Request # into form C.# and reset
+23 ; request node:
+24 ; was #;GMR(123,
SET TIUCNNBR=$PIECE(TIUCNNBR,";")
+25 SET TIUFLDS(1405)=$$TRNSFRM^TIUPEFIX(TIUTYPE,1405,TIUCNNBR)
+26 SET SUCCESS=1
+27 QUIT
+28 ;
GETCNSLT(SUCCESS,TIUTYPE,TIUFLDS,CHANGEPT,TIUCNNBR) ; Get consult
+1 ;request from user
+2 NEW CLINPROC,TIUOVR,DOCNUM,Y
+3 SET SUCCESS="0^Consult Request is Required."
+4 ;Don't have a docmt yet
SET CLINPROC=0
SET TIUOVR=1
SET DOCNUM=0
+5 SET TIUCNNBR=$$GETCNSLT^TIUCNSLT(DFN,CLINPROC,DOCNUM,TIUOVR)
+6 ; -- Pt has no requests:
+7 IF +TIUCNNBR=-1
Begin DoDot:1
+8 WRITE !!,"This patient has no consult requests; please make sure you have the"
+9 WRITE !,"correct patient."
+10 SET Y=$$READ^TIUU("YO"," Want to change the patient","YES")
+11 IF Y
SET CHANGEPT=1
QUIT
+12 IF $DATA(DIRUT)
QUIT
+13 ; -- Ask user if want to change to PN:
+14 SET Y=$$ASKCHNG^TIUFIX(2,.TIUTYPE)
End DoDot:1
QUIT
+15 ; -- User did not select request:
+16 IF +TIUCNNBR=0
Begin DoDot:1
+17 WRITE !!,"To upload into a consult title, you must select a request."
+18 SET Y=$$ASKCHNG^TIUFIX(2,.TIUTYPE)
End DoDot:1
+19 QUIT
+20 ;
