TIUFIX ; SLC/JER,MAM - Resolve Upload Filing Errors Library ;10/19/06 14:31
;;1.0;TEXT INTEGRATION UTILITIES;**131,211**;Jun 20, 1997;Build 26
;
TITLDFLT(TRANTITL,TIUTYPE,BADTYPES) ; Return default title
; Call with: [TRANTITL] - transcribed title
; [TIUTYPE] - type of docmt being uploaded
; [BADTYPES] - ^-delimited string of types default
; should NOT be (optional)
; Returns: Title - transcribed title if TRANTITL is a
; unique TITLE of type TIUTYPE and
; not of a type in list BADTYPES.
; Null Otherwise
N DIC,X,Y,TITLE,TITLDA
S DIC=8925.1,DIC(0)="X"
S X=TRANTITL,DIC("S")="I $P(^(0),U,4)=""DOC""" D ^DIC
D ^DIC
S TITLDA=+Y
S TITLE=$S(Y>0:$P(Y,U,2),1:"")
; -- Require/Disallow types:
I TITLDA>0,+$$ISA^TIULX(TITLDA,TIUTYPE)'>0 S TITLE=""
I TITLDA>0,$$ISTYPE(TITLDA,BADTYPES) S TITLE=""
Q TITLE
;
ISTYPE(TITLDA,TYPELIST) ; Is TITLDA in list TYPELIST?
; Requires TITLDA
; Requires TYPELIST of form typeien^typeien^typeien etc., or null
N ANS,TIUI,TYPE
S ANS=0
F TIUI=1:+1 S TYPE=$P(TYPELIST,U,TIUI) Q:'TYPE D G:ANS ISTYPEX
. I +$$ISA^TIULX(TITLDA,TYPE)>0 S ANS=1
ISTYPEX Q ANS
;
GETTITLE(SUCCESS,TIUTYPE,TIUFLDS,TITLDA,BADTYPES,ASK) ; Get title from user
; SUCCESS - Passed back
; TIUTYPE - Type of docmt being uploaded
; TIUFLDS - Array of transcribed data, as set in LOADHDR^TIUFIX2
; TITLDA - Gotten from user and passed back
; BADTYPES - ^-delimited list of types title CANNOT be (optional)
; ASK - Flag to ask user if they want to change
; type to progress note (optional)
N DEFAULT,Y,SCREEN,TYPENM
S SUCCESS="0^Title is Required."
S DEFAULT=$$TITLDFLT($G(TIUFLDS(.01)),TIUTYPE,$G(BADTYPES))
S SCREEN="I $P(^TIU(8925.1,+Y,0),U,4)=""DOC"",($P(^(0),U)'[""ADDENDUM""),+$$ISA^TIULX(+Y,+TIUTYPE),+$$CANPICK^TIULP(+Y),+$$CANENTR^TIULP(+Y),'$$ISTYPE^TIUFIX(+Y,$G(BADTYPES))"
S TYPENM=$$PNAME^TIULC1(+TIUTYPE)
W !!," Please enter a ",$$PNAME^TIULC1(+TIUTYPE)," title"
I '$G(ASK) W "."
I $G(ASK) W ", or enter '^' to exit",!,"or to change document to a Progress Note."
; -- Ask user for title:
S TITLDA=$$ASKTYP^TIULA2(+TIUTYPE,DEFAULT,SCREEN,"TITLE: ",1)
I TITLDA>0 S SUCCESS=1
Q:'$G(ASK)
I TITLDA'>0 D
. W !,"Title is Required.",!
. ; -- Ask user if want to change to PN:
. K DIRUT S Y=$$ASKCHNG(1,.TIUTYPE)
. ; -- Quit if user ^d or user said yes:
. Q:$D(DIRUT)
. Q:TIUTYPE=3
. ; -- Reprompt for same type of title if user said no:
. W !," OK, please enter a ",TYPENM," title."
. S TITLDA=$$ASKTYP^TIULA2(+TIUTYPE,DEFAULT,SCREEN,"TITLE: ",1)
. I TITLDA>0 S SUCCESS=1
Q
;
ASKCHNG(ONEORTWO,TIUTYPE) ; Ask user if they want to change doc type
;to Progress Notes
; [ONEORTWO] - Which help msg, as below
; [TIUTYPE] - Passed back = 3 if user wants to change to PN
N HELP,HELP1,HELP2,ANS
S HELP="If you are sure there is no request to associate with this document, answer 'YES' to upload into a progress note. If you are not sure,"
S HELP1=HELP_" answer 'NO' and enter a consult title. You can change your mind later."
S HELP2=HELP_" answer 'NO' and come back and resolve the error later."
S HELP=$S(ONEORTWO=1:HELP1,1:HELP2)
S ANS=$$READ^TIUU("YO","Want to upload into a progress note instead of a consults title","NO",HELP)
I ANS S TIUTYPE=3
ASKX Q ANS
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUFIX 3460 printed Dec 13, 2024@02:40:54 Page 2
TIUFIX ; SLC/JER,MAM - Resolve Upload Filing Errors Library ;10/19/06 14:31
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**131,211**;Jun 20, 1997;Build 26
+2 ;
TITLDFLT(TRANTITL,TIUTYPE,BADTYPES) ; Return default title
+1 ; Call with: [TRANTITL] - transcribed title
+2 ; [TIUTYPE] - type of docmt being uploaded
+3 ; [BADTYPES] - ^-delimited string of types default
+4 ; should NOT be (optional)
+5 ; Returns: Title - transcribed title if TRANTITL is a
+6 ; unique TITLE of type TIUTYPE and
+7 ; not of a type in list BADTYPES.
+8 ; Null Otherwise
+9 NEW DIC,X,Y,TITLE,TITLDA
+10 SET DIC=8925.1
SET DIC(0)="X"
+11 SET X=TRANTITL
SET DIC("S")="I $P(^(0),U,4)=""DOC"""
DO ^DIC
+12 DO ^DIC
+13 SET TITLDA=+Y
+14 SET TITLE=$SELECT(Y>0:$PIECE(Y,U,2),1:"")
+15 ; -- Require/Disallow types:
+16 IF TITLDA>0
IF +$$ISA^TIULX(TITLDA,TIUTYPE)'>0
SET TITLE=""
+17 IF TITLDA>0
IF $$ISTYPE(TITLDA,BADTYPES)
SET TITLE=""
+18 QUIT TITLE
+19 ;
ISTYPE(TITLDA,TYPELIST) ; Is TITLDA in list TYPELIST?
+1 ; Requires TITLDA
+2 ; Requires TYPELIST of form typeien^typeien^typeien etc., or null
+3 NEW ANS,TIUI,TYPE
+4 SET ANS=0
+5 FOR TIUI=1:+1
SET TYPE=$PIECE(TYPELIST,U,TIUI)
if 'TYPE
QUIT
Begin DoDot:1
+6 IF +$$ISA^TIULX(TITLDA,TYPE)>0
SET ANS=1
End DoDot:1
if ANS
GOTO ISTYPEX
ISTYPEX QUIT ANS
+1 ;
GETTITLE(SUCCESS,TIUTYPE,TIUFLDS,TITLDA,BADTYPES,ASK) ; Get title from user
+1 ; SUCCESS - Passed back
+2 ; TIUTYPE - Type of docmt being uploaded
+3 ; TIUFLDS - Array of transcribed data, as set in LOADHDR^TIUFIX2
+4 ; TITLDA - Gotten from user and passed back
+5 ; BADTYPES - ^-delimited list of types title CANNOT be (optional)
+6 ; ASK - Flag to ask user if they want to change
+7 ; type to progress note (optional)
+8 NEW DEFAULT,Y,SCREEN,TYPENM
+9 SET SUCCESS="0^Title is Required."
+10 SET DEFAULT=$$TITLDFLT($GET(TIUFLDS(.01)),TIUTYPE,$GET(BADTYPES))
+11 SET SCREEN="I $P(^TIU(8925.1,+Y,0),U,4)=""DOC"",($P(^(0),U)'[""ADDENDUM""),+$$ISA^TIULX(+Y,+TIUTYPE),+$$CANPICK^TIULP(+Y),+$$CANENTR^TIULP(+Y),'$$ISTYPE^TIUFIX(+Y,$G(BADTYPES))"
+12 SET TYPENM=$$PNAME^TIULC1(+TIUTYPE)
+13 WRITE !!," Please enter a ",$$PNAME^TIULC1(+TIUTYPE)," title"
+14 IF '$GET(ASK)
WRITE "."
+15 IF $GET(ASK)
WRITE ", or enter '^' to exit",!,"or to change document to a Progress Note."
+16 ; -- Ask user for title:
+17 SET TITLDA=$$ASKTYP^TIULA2(+TIUTYPE,DEFAULT,SCREEN,"TITLE: ",1)
+18 IF TITLDA>0
SET SUCCESS=1
+19 if '$GET(ASK)
QUIT
+20 IF TITLDA'>0
Begin DoDot:1
+21 WRITE !,"Title is Required.",!
+22 ; -- Ask user if want to change to PN:
+23 KILL DIRUT
SET Y=$$ASKCHNG(1,.TIUTYPE)
+24 ; -- Quit if user ^d or user said yes:
+25 if $DATA(DIRUT)
QUIT
+26 if TIUTYPE=3
QUIT
+27 ; -- Reprompt for same type of title if user said no:
+28 WRITE !," OK, please enter a ",TYPENM," title."
+29 SET TITLDA=$$ASKTYP^TIULA2(+TIUTYPE,DEFAULT,SCREEN,"TITLE: ",1)
+30 IF TITLDA>0
SET SUCCESS=1
End DoDot:1
+31 QUIT
+32 ;
ASKCHNG(ONEORTWO,TIUTYPE) ; Ask user if they want to change doc type
+1 ;to Progress Notes
+2 ; [ONEORTWO] - Which help msg, as below
+3 ; [TIUTYPE] - Passed back = 3 if user wants to change to PN
+4 NEW HELP,HELP1,HELP2,ANS
+5 SET HELP="If you are sure there is no request to associate with this document, answer 'YES' to upload into a progress note. If you are not sure,"
+6 SET HELP1=HELP_" answer 'NO' and enter a consult title. You can change your mind later."
+7 SET HELP2=HELP_" answer 'NO' and come back and resolve the error later."
+8 SET HELP=$SELECT(ONEORTWO=1:HELP1,1:HELP2)
+9 SET ANS=$$READ^TIUU("YO","Want to upload into a progress note instead of a consults title","NO",HELP)
+10 IF ANS
SET TIUTYPE=3
ASKX QUIT ANS
