source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUFIX.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.3 KB
RevLine 
[613]1TIUFIX ; SLC/JER,MAM - Resolve Upload Filing Errors Library ;10/19/06 14:31
2 ;;1.0;TEXT INTEGRATION UTILITIES;**131,211**;Jun 20, 1997;Build 26
3 ;
4TITLDFLT(TRANTITL,TIUTYPE,BADTYPES) ; Return default title
5 ; Call with: [TRANTITL] - transcribed title
6 ; [TIUTYPE] - type of docmt being uploaded
7 ; [BADTYPES] - ^-delimited string of types default
8 ; should NOT be (optional)
9 ; Returns: Title - transcribed title if TRANTITL is a
10 ; unique TITLE of type TIUTYPE and
11 ; not of a type in list BADTYPES.
12 ; Null Otherwise
13 N DIC,X,Y,TITLE,TITLDA
14 S DIC=8925.1,DIC(0)="X"
15 S X=TRANTITL,DIC("S")="I $P(^(0),U,4)=""DOC""" D ^DIC
16 D ^DIC
17 S TITLDA=+Y
18 S TITLE=$S(Y>0:$P(Y,U,2),1:"")
19 ; -- Require/Disallow types:
20 I TITLDA>0,+$$ISA^TIULX(TITLDA,TIUTYPE)'>0 S TITLE=""
21 I TITLDA>0,$$ISTYPE(TITLDA,BADTYPES) S TITLE=""
22 Q TITLE
23 ;
24ISTYPE(TITLDA,TYPELIST) ; Is TITLDA in list TYPELIST?
25 ; Requires TITLDA
26 ; Requires TYPELIST of form typeien^typeien^typeien etc., or null
27 N ANS,TIUI,TYPE
28 S ANS=0
29 F TIUI=1:+1 S TYPE=$P(TYPELIST,U,TIUI) Q:'TYPE D G:ANS ISTYPEX
30 . I +$$ISA^TIULX(TITLDA,TYPE)>0 S ANS=1
31ISTYPEX Q ANS
32 ;
33GETTITLE(SUCCESS,TIUTYPE,TIUFLDS,TITLDA,BADTYPES,ASK) ; Get title from user
34 ; SUCCESS - Passed back
35 ; TIUTYPE - Type of docmt being uploaded
36 ; TIUFLDS - Array of transcribed data, as set in LOADHDR^TIUFIX2
37 ; TITLDA - Gotten from user and passed back
38 ; BADTYPES - ^-delimited list of types title CANNOT be (optional)
39 ; ASK - Flag to ask user if they want to change
40 ; type to progress note (optional)
41 N DEFAULT,Y,SCREEN,TYPENM
42 S SUCCESS="0^Title is Required."
43 S DEFAULT=$$TITLDFLT($G(TIUFLDS(.01)),TIUTYPE,$G(BADTYPES))
44 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))"
45 S TYPENM=$$PNAME^TIULC1(+TIUTYPE)
46 W !!," Please enter a ",$$PNAME^TIULC1(+TIUTYPE)," title"
47 I '$G(ASK) W "."
48 I $G(ASK) W ", or enter '^' to exit",!,"or to change document to a Progress Note."
49 ; -- Ask user for title:
50 S TITLDA=$$ASKTYP^TIULA2(+TIUTYPE,DEFAULT,SCREEN,"TITLE: ",1)
51 I TITLDA>0 S SUCCESS=1
52 Q:'$G(ASK)
53 I TITLDA'>0 D
54 . W !,"Title is Required.",!
55 . ; -- Ask user if want to change to PN:
56 . K DIRUT S Y=$$ASKCHNG(1,.TIUTYPE)
57 . ; -- Quit if user ^d or user said yes:
58 . Q:$D(DIRUT)
59 . Q:TIUTYPE=3
60 . ; -- Reprompt for same type of title if user said no:
61 . W !," OK, please enter a ",TYPENM," title."
62 . S TITLDA=$$ASKTYP^TIULA2(+TIUTYPE,DEFAULT,SCREEN,"TITLE: ",1)
63 . I TITLDA>0 S SUCCESS=1
64 Q
65 ;
66ASKCHNG(ONEORTWO,TIUTYPE) ; Ask user if they want to change doc type
67 ;to Progress Notes
68 ; [ONEORTWO] - Which help msg, as below
69 ; [TIUTYPE] - Passed back = 3 if user wants to change to PN
70 N HELP,HELP1,HELP2,ANS
71 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,"
72 S HELP1=HELP_" answer 'NO' and enter a consult title. You can change your mind later."
73 S HELP2=HELP_" answer 'NO' and come back and resolve the error later."
74 S HELP=$S(ONEORTWO=1:HELP1,1:HELP2)
75 S ANS=$$READ^TIUU("YO","Want to upload into a progress note instead of a consults title","NO",HELP)
76 I ANS S TIUTYPE=3
77ASKX Q ANS
Note: See TracBrowser for help on using the repository browser.