source: FOIAVistA/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUPNAPI.m@ 794

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

initial load of FOIAVistA 6/30/08 version
File size: 6.5 KB
Line 
1TIUPNAPI ; SLC/JER - API to Replace GMRPAPI ; 8/8/05
2 ;;1.0;TEXT INTEGRATION UTILITIES;**57,140,175,180,184**;Jun 20, 1997
3 ;
4 ; ^DPT( IA #3101
5NEW(TIUIFN,DFN,TIUAUTH,TIURDT,TIUTITLE,TIULOC,TIUES,TIUPRT,TIUESBY,TIUASKVS,TIUADEL) ;
6 ; -- Create new note
7 ;****************
8 ; Return variable (must pass by reference):
9 ; TIUIFN (pass by ref) = New note IFN in file 8925, -1 if error,
10 ; = IFN^-1 if note filed, w/o signature when
11 ; TIUES=1 (It has been IFN^-1 as far back
12 ; as patch 140. Noted on 8/4/05)
13 ; = -1 if user fails to enter valid cosig
14 ; = IFN^-1 if TIUESBY>0 & signature fails,
15 ; if TIUADEL not present
16 ; = -1^-1 if TIUESBY>0 & signature fails,
17 ; if TIUADEL is present
18 ; = -1^-1 if TIUES=1 and user deletes note
19 ; Required Input parameters:
20 ; DFN = Patient IFN in file #2
21 ; TIUAUTH = Author IFN in file #200
22 ; TIURDT = Date/time of note in FM format
23 ; TIUTITLE = Title IFN in file 8925.1
24 ; Required global variable:
25 ; ^TMP("TIUP",$J) = Array root for text in format compatible
26 ; w/FM Word-processing fields. e.g.,
27 ; ^TMP("TIUP",$J,0)=^^1^1^2961216^
28 ; ^TMP("TIUP",$J,1,0)=Testing the TIUPNAPI.
29 ;
30 ; NOTE: you no longer need to use the
31 ; additional subscript to designate where
32 ; the text should go (e.g., 10 for Admission
33 ; Note).
34 ; Optional Input variables:
35 ; TIULOC = Patient Location IFN in file #44
36 ; TIUES = 1 if TIU should prompt/process E-SIG
37 ; TIUPRT = 1 if TIU should prompt user to print note
38 ; TIUESBY = Signer IFN in file #200: Calling App is
39 ; resonsible for Electronic Signature
40 ; TIUASKVS = BOOLEAN flag indicating whether to ask for visit
41 ; NOTE: If TIUESBY is passed, the document will be marked as
42 ; signed at the time the encrypted signature block name
43 ; and title are filed
44 ; TIUADEL = BOOLEAN flag for automatic delete if TIUESBY>0 and
45 ; signature fails instead of leaving UNSIGNED doc.
46 ;****************
47 ;
48 N TIUX,TIUCHNG,TIUHIT,TIUPRM0,TIUPRM1,TIUTYP,TIUOUT,TIUDPRM,TIUVSTR
49 N COSPROB,AUTHSIGN
50 S TIUIFN=-1,COSPROB=0
51 I $D(^TMP("TIUP",$J))'>9 Q ; If no text, quit
52 I '$D(^DPT(+$G(DFN),0)) G EXIT ; if not valid patient, clean-up & quit
53 I $L($$GET1^DIQ(200,+$G(TIUAUTH),.01))'>0 G EXIT ; if not valid author, clean-up & quit
54 I '$D(^TIU(8925.1,+$G(TIUTITLE),0)) G EXIT ; if not valid title, clean-up & quit
55 I $S(+$G(TIURDT)'>0:1,+$G(TIURDT)>+$$NOW^XLFDT:1,+$$FMTH^XLFDT(TIURDT)'>0:1,1:0) G EXIT
56 I $S('($D(DUZ)#2):1,$L($$GET1^DIQ(200,DUZ,.01))'>0:1,1:0) G EXIT
57 S TIUASKVS=+$G(TIUASKVS)
58 ; -- Okay, create new note
59 S TIUX(1202)=TIUAUTH,TIUX(1301)=TIURDT
60 ; get doc parameters
61 D DOCPRM^TIULC1(TIUTITLE,.TIUDPRM)
62 I +TIUASKVS D G:+$G(TIUOUT) EXIT
63 . N TIUBY,TIU,TIUY
64 . D ENPN^TIUVSIT(.TIU,DFN,1)
65 . I '$D(TIU) S TIUOUT=1,TIUIFN=-1 Q
66 . S TIUY=$$CHEKPN^TIULD(.TIU,.TIUBY)
67 . I '+TIUY S TIUOUT=1,TIUIFN=-1 Q
68 . I '$L($G(TIU("VSTR"))) S TIUOUT=1,TIUIFN=-1 Q
69 . S TIUVSTR=$G(TIU("VSTR")),TIULOC=+$G(TIU("LOC"))
70 . I +$G(TIU("STOP")),(+$P(TIUDPRM(0),U,14)'=1) S TIUX(.11)=1
71 M TIUX("TEXT")=^TMP("TIUP",$J)
72 D MAKE^TIUSRVP(.TIUIFN,DFN,TIUTITLE,TIURDT,$G(TIULOC),"",.TIUX,$G(TIUVSTR))
73 I +TIUIFN'>0 S TIUIFN=-1 G EXIT
74 ; -- If author requires cosig, then
75 ; If we're not interactive we can't get Exp Cos so we have
76 ; a cosig problem:
77 S AUTHSIGN=$S($G(TIUESBY):TIUESBY,1:TIUAUTH)
78 I +$$REQCOSIG^TIULP(TIUTITLE,"",AUTHSIGN) D G:+$G(TIUOUT) EXIT
79 . I $D(ZTQUEUED) S COSPROB=1 Q ; called from a task
80 . I $D(XWBOS) S COSPROB=1 Q ; called from RPCBroker app
81 . ; -- If we are interactive, get Exp Cos. Get it after note
82 . ; is created since screen needs IFN:
83 . N DIE,DA,DR,X,Y,COSNEED,EXPCOS
84 . S COSNEED=1
85 . S EXPCOS=$$GETCOSNR(+TIUIFN)
86 . I EXPCOS'>0 D DELETE^TIUSRVP("",+TIUIFN,"",1) S TIUIFN=-1,TIUOUT=1 Q
87 . S DIE=8925,DR="1208////^S X=EXPCOS;1506////^S X=COSNEED",DA=+TIUIFN D ^DIE
88 I '+$G(TIUESBY),(+$G(TIUES)>0) D I +$G(TIUOUT) G EXIT
89 . N VALMBCK
90 . ; -- Present Browse Screen so user can sign:
91 . D EXSTNOTE^TIUBR1(DFN,TIUIFN) I '$D(^TIU(8925,+TIUIFN,0)) S TIUIFN="-1^-1",TIUOUT=1 Q
92 . I +$P(^TIU(8925,+TIUIFN,0),U,5)<6 S TIUIFN=TIUIFN_"^-1"
93 ; -- If esig done by calling app:
94 ; but there IS a cosig problem and caller doesn't want unsigned
95 ; docmts left around, delete docmt:
96 I +$G(TIUESBY),COSPROB,$G(TIUADEL) D DELETE^TIUSRVP("",+TIUIFN,"",1) S TIUIFN="-1^-1" G EXIT
97 ; but if unsigned is OK, leave it unsigned:
98 I +$G(TIUESBY),COSPROB S TIUIFN=TIUIFN_"^-1"
99 ; -- If esig done by calling app and no cosig problem,
100 ; mark it signed. If sig fails and caller doesn't
101 ; want unsigned docmts left around, delete docmt:
102 I +$G(TIUESBY),'COSPROB D MARKSIGN(.TIUIFN,+$G(TIUESBY)) I +$G(TIUADEL),+$P(^TIU(8925,+TIUIFN,0),U,5)<6 D DELETE^TIUSRVP("",+TIUIFN,"",1) S TIUIFN="-1^-1" G EXIT
103 D SEND^TIUALRT(+TIUIFN)
104EXIT K ^TMP("TIUP",$J)
105 Q
106WHATITLE(X) ; -- Given a freetext title, return pointer to file 8925.1
107 Q $$WHATITLE^TIUPUTU(X)
108 ;
109GETCOSNR(TIUIEN) ; Function Asks Expected Cosigner
110 N TIUY,HELP
111 S HELP="You may not select self, author, or others who require cosignature."
112 S TIUY=$$READ^TIUU("P^200:AEMQ","EXPECTED COSIGNER","",HELP,"I $$SCRCSNR^TIULA3(TIUIEN,+Y)")
113 Q +$G(TIUY)
114 ;
115MARKSIGN(TIUDA,TIUESBY) ; Mark note as electronically signed
116 N ESNAME,ESTITLE,ESBLOCK
117 I $S(+$G(TIUESBY)'>0:1,$L($$GET1^DIQ(200,+$G(TIUESBY),.01))'>0:1,+$$CANDO^TIULP(TIUDA,"SIGNATURE",$G(TIUESBY))'>0:1,1:0) S TIUDA=TIUDA_U_-1 Q
118 S ESNAME=$$GET1^DIQ(200,+TIUESBY,20.2),ESTITLE=$$GET1^DIQ(200,+TIUESBY,20.3)
119 S ESBLOCK="1^"_ESNAME_U_ESTITLE
120 D ES^TIURS(TIUDA,ESBLOCK)
121 I +$P(^TIU(8925,+TIUIFN,0),U,5)<6 S TIUDA=TIUDA_"^-1"
122 Q
123TEST ; Interactive Test
124 N DUOUT,DFN,TITLE,TIUTYP,TIURDT,TIUDA,DIC K ^TMP("TIUP",$J)
125 W !,"First, collect the data to pass to the API...",!
126 S DFN=+$$PATIENT^TIULA Q:+DFN'>0
127 D DOCSPICK^TIULA2(.TIUTYP,3,"1A","","","+$$CANPICK^TIULP(+Y),+$$CANENTR^TIULP(+Y)")
128 S TITLE=$P($G(TIUTYP(1)),U,2) Q:+TITLE'>0
129 S TIURDT=+$$NOW^XLFDT
130 S DIC="^TMP(""TIUP"",$J," D EN^DIWE
131 W !,"NOW, call the API!",!
132 D NEW(.TIUDA,DFN,DUZ,TIURDT,TITLE,"",1,1,"",1)
133 Q
Note: See TracBrowser for help on using the repository browser.