source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUSRVPT.m@ 1787

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

initial load of WorldVistAEHR
File size: 3.6 KB
RevLine 
[613]1TIUSRVPT ; SLC/JER - Set Methods for Documents ;11/17/06 12:00
2 ;;1.0;TEXT INTEGRATION UTILITIES;**122,175,186,210,223**;Jun 20, 1997;Build 3
3SETTEXT(TIUY,TIUDA,TIUX,SUPPRESS) ; Save Text - use Buffered I/O
4 N PAGES,PAGE S TIUY=0,SUPPRESS=$G(SUPPRESS,0)
5 I $S(+$G(TIUDA)'>0:1,'$D(^TIU(8925,+TIUDA,0)):1,1:0) D Q
6 . S TIUY="0^0^0^Attempt to file data in a Nonexistent Entry."
7 . D ERROR(TIUY)
8 S PAGE=$P($G(TIUX("HDR")),U),PAGES=$P($G(TIUX("HDR")),U,2)
9 I $S('PAGE:1,'PAGES:1,1:0) D Q
10 . S TIUY="0^0^0^Invalid text block header"
11 . D ERROR(TIUY)
12 ; I PAGE=1 D MERGTEMP^TIUEDI1(TIUDA) K ^TIU(8925,+TIUDA,"TEMP"),^("TEXT")
13 I PAGE=1 K ^TIU(8925,+TIUDA,"TEMP")
14 M ^TIU(8925,+TIUDA,"TEMP")=TIUX("TEXT")
15 ;if done, commit changes
16 I 'SUPPRESS,(PAGE=PAGES),$D(^TIU(8925,TIUDA,"TEMP")) D
17 . N TIUC,TIUI,TIU S (TIUC,TIUI)=0
18 . F S TIUI=$O(^TIU(8925,TIUDA,"TEMP",TIUI)) Q:+TIUI'>0 D
19 . . S TIUC=TIUC+1
20 . I TIUC>0 S ^TIU(8925,TIUDA,"TEMP",0)="^^"_TIUC_U_TIUC_U_DT_"^^"
21 . D GETTIU^TIULD(.TIU,TIUDA)
22 . K ^TIU(8925,TIUDA,"TEXT")
23 . D
24 . . N TIUC
25 . . S TIUC=0 F S TIUC=$O(^TIU(8925,"DAD",TIUDA,TIUC)) Q:+TIUC'>0 D
26 . . . I +$$ISADDNDM^TIULC1(+TIUC) Q
27 . . . K ^TIU(8925,+TIUC,"TEXT")
28 . D MERGTEXT^TIUEDI1(+TIUDA,.TIU)
29 . K ^TIU(8925,TIUDA,"TEMP")
30 ; Acknowledge success / ask for next page
31 S TIUY=TIUDA_U_PAGE_U_PAGES
32 Q
33ADMNCLOS(TIUY,TIUDA,MODE,PERSON) ; Post Administrative Closure Information
34 N TIUX,TIUI,TIUCLBY,TIUCLTTL,TIUCAPT
35 I '$D(^TIU(8925,TIUDA)) S TIUY="0^Attempt to file data in a Nonexistent Entry." Q
36 S MODE=$G(MODE,"S")
37 S TIUCAPT=$S("ES"[MODE:" Electronically Filed: ",1:"Administrative Closure: ")
38 S PERSON=$G(PERSON,DUZ)
39 S TIUCLBY=$$SIGNAME^TIULS(PERSON)
40 S TIUCLTTL=$$SIGTITL^TIULS(PERSON)
41 S TIUX(.05)=7
42 S TIUX(1606)=$G(DT)
43 S TIUX(1607)=TIUCLBY
44 S TIUX(1608)=TIUCLTTL
45 S TIUX(1613)=MODE
46 D FILE^TIUSRVP(.TIUY,TIUDA,.TIUX)
47 S TIUI=$P($G(^TIU(8925,TIUDA,"TEXT",0)),U,3)+1
48 ;If scanned document set document body to informational text
49 I MODE="S" D
50 . S ^TIU(8925,+TIUDA,"TEXT",TIUI,0)=" ",TIUI=TIUI+1
51 . S ^TIU(8925,+TIUDA,"TEXT",TIUI,0)=" *** SCANNED DOCUMENT ***",TIUI=TIUI+1
52 . S ^TIU(8925,+TIUDA,"TEXT",TIUI,0)=" SIGNATURE NOT REQUIRED",TIUI=TIUI+1
53 . S ^TIU(8925,+TIUDA,"TEXT",TIUI,0)=" ",TIUI=TIUI+1
54 S ^TIU(8925,TIUDA,"TEXT",TIUI,0)=" ",TIUI=TIUI+1
55 S ^TIU(8925,TIUDA,"TEXT",TIUI,0)=TIUCAPT_$$DATE^TIULS(DT,"MM/DD/CCYY"),TIUI=TIUI+1
56 S ^TIU(8925,TIUDA,"TEXT",TIUI,0)=" by: "_TIUCLBY,TIUI=TIUI+1
57 S ^TIU(8925,TIUDA,"TEXT",TIUI,0)=" "_TIUCLTTL
58 S ^TIU(8925,+TIUDA,"TEXT",0)="^^"_TIUI_U_TIUI_U_DT_"^^"
59 D ALERTDEL^TIUALRT(TIUDA)
60 ; post-signature action for administratively closed docs
61 N TIUCONS,TIUSTIS,TIUTTL,TIUPSIG,DA S TIUCONS=-1
62 D ISCNSLT^TIUCNSLT(.TIUCONS,+$G(^TIU(8925,TIUDA,0)))
63 S TIUSTIS=$P($G(^TIU(8925,TIUDA,0)),U,5)
64 S TIUTTL=+$G(^TIU(8925,+TIUDA,0)),TIUPSIG=$$POSTSIGN^TIULC1(TIUTTL)
65 I +$L(TIUPSIG) S DA=TIUDA X TIUPSIG
66 I TIUCONS,TIUSTIS=7,$$HASKIDS^TIUSRVLI(TIUDA) D
67 . N SEQUENCE,TIUKIDS,TIUINT,TIUK
68 . S SEQUENCE="D",TIUKIDS="TIUKIDS",TIUINT=0,TIUK=0
69 . D SETKIDS^TIUSRVLI(TIUKIDS,TIUDA,TIUINT)
70 . F S TIUK=$O(TIUKIDS(TIUK)) Q:'TIUK D
71 . . I $P(TIUKIDS(TIUK),U,7)="completed" X TIUPSIG
72 Q
73ERROR(ECODE) ; Register AUTOSAVE Error
74 N ERRDT S ERRDT=+$$NOW^XLFDT
75 Q:+$G(^XTMP("TIUERR","COUNT"))'<100
76 I '$D(^XTMP("TIUERR",0)) D
77 . S ^XTMP("TIUERR",0)=$$FMADD^XLFDT(DT,90)_U_DT
78 S ^XTMP("TIUERR",ERRDT,"ECODE")=ECODE
79 S ^XTMP("TIUERR",ERRDT,"USER")=DUZ
80 S ^XTMP("TIUERR",ERRDT,"TIUDA")=$G(TIUDA,"UNDEFINED")
81 S ^XTMP("TIUERR",ERRDT,"TIUHDR")=$G(TIUX("HDR"))
82 S ^XTMP("TIUERR",ERRDT,"XWBHDR")=$G(XWBS1("HDR"))
83 S ^XTMP("TIUERR","COUNT")=$G(^XTMP("TIUERR","COUNT"))+1
84 Q
Note: See TracBrowser for help on using the repository browser.