Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: TIUFIX

TIUFIX.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1. TITLDFLT(TRANTITL,TIUTYPE,BADTYPES) ; Return default title
  1.  ; Call with: [TRANTITL] - transcribed title
  1.  ;             [TIUTYPE] - type of docmt being uploaded
  1.  ;            [BADTYPES] - ^-delimited string of types default
  1.  ;                         should NOT be (optional)
  1.  ; Returns:        Title - transcribed title if TRANTITL is a 
  1.  ;                         unique TITLE of type TIUTYPE and
  1.  ;                         not of a type in list BADTYPES.
  1.  ;                         Null Otherwise
  1.  N DIC,X,Y,TITLE,TITLDA
  1.  S DIC=8925.1,DIC(0)="X"
  1.  S X=TRANTITL,DIC("S")="I $P(^(0),U,4)=""DOC""" D ^DIC
  1.  D ^DIC
  1.  S TITLDA=+Y
  1.  S TITLE=$S(Y>0:$P(Y,U,2),1:"")
  1.  ; -- Require/Disallow types:
  1.  I TITLDA>0,+$$ISA^TIULX(TITLDA,TIUTYPE)'>0 S TITLE=""
  1.  I TITLDA>0,$$ISTYPE(TITLDA,BADTYPES) S TITLE=""
  1.  Q TITLE
  1.  ;
  1. ISTYPE(TITLDA,TYPELIST) ; Is TITLDA in list TYPELIST?
  1.  ; Requires TITLDA
  1.  ; Requires TYPELIST of form typeien^typeien^typeien etc., or null
  1.  N ANS,TIUI,TYPE
  1.  S ANS=0
  1.  F TIUI=1:+1 S TYPE=$P(TYPELIST,U,TIUI) Q:'TYPE  D  G:ANS ISTYPEX
  1.  . I +$$ISA^TIULX(TITLDA,TYPE)>0 S ANS=1
  1. ISTYPEX Q ANS
  1.  ;
  1. GETTITLE(SUCCESS,TIUTYPE,TIUFLDS,TITLDA,BADTYPES,ASK) ; Get title from user
  1.  ;   SUCCESS - Passed back
  1.  ;   TIUTYPE - Type of docmt being uploaded
  1.  ;   TIUFLDS - Array of transcribed data, as set in LOADHDR^TIUFIX2
  1.  ;    TITLDA - Gotten from user and passed back
  1.  ;  BADTYPES - ^-delimited list of types title CANNOT be (optional)
  1.  ;       ASK - Flag to ask user if they want to change
  1.  ;             type to progress note (optional)
  1.  N DEFAULT,Y,SCREEN,TYPENM
  1.  S SUCCESS="0^Title is Required."
  1.  S DEFAULT=$$TITLDFLT($G(TIUFLDS(.01)),TIUTYPE,$G(BADTYPES))
  1.  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))"
  1.  S TYPENM=$$PNAME^TIULC1(+TIUTYPE)
  1.  W !!,"  Please enter a ",$$PNAME^TIULC1(+TIUTYPE)," title"
  1.  I '$G(ASK) W "."
  1.  I $G(ASK) W ", or enter '^' to exit",!,"or to change document to a Progress Note."
  1.  ; -- Ask user for title:
  1.  S TITLDA=$$ASKTYP^TIULA2(+TIUTYPE,DEFAULT,SCREEN,"TITLE: ",1)
  1.  I TITLDA>0 S SUCCESS=1
  1.  Q:'$G(ASK)
  1.  I TITLDA'>0 D
  1.  . W !,"Title is Required.",!
  1.  . ; -- Ask user if want to change to PN:
  1.  . K DIRUT S Y=$$ASKCHNG(1,.TIUTYPE)
  1.  . ; -- Quit if user ^d or user said yes:
  1.  . Q:$D(DIRUT)
  1.  . Q:TIUTYPE=3
  1.  . ; -- Reprompt for same type of title if user said no:
  1.  . W !,"  OK, please enter a ",TYPENM," title."
  1.  . S TITLDA=$$ASKTYP^TIULA2(+TIUTYPE,DEFAULT,SCREEN,"TITLE: ",1)
  1.  . I TITLDA>0 S SUCCESS=1
  1.  Q
  1.  ;
  1. ASKCHNG(ONEORTWO,TIUTYPE) ; Ask user if they want to change doc type
  1.  ;to Progress Notes
  1.  ; [ONEORTWO] - Which help msg, as below
  1.  ; [TIUTYPE] - Passed back = 3 if user wants to change to PN
  1.  N HELP,HELP1,HELP2,ANS
  1.  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,"
  1.  S HELP1=HELP_" answer 'NO' and enter a consult title.  You can change your mind later."
  1.  S HELP2=HELP_" answer 'NO' and come back and resolve the error later."
  1.  S HELP=$S(ONEORTWO=1:HELP1,1:HELP2)
  1.  S ANS=$$READ^TIUU("YO","Want to upload into a progress note instead of a consults title","NO",HELP)
  1.  I ANS S TIUTYPE=3
  1. ASKX Q ANS