source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUAPIOK.m@ 1389

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

initial load of WorldVistAEHR

File size: 3.3 KB
Line 
1TIUAPIOK ; SLC/JER - Check out PUT API's
2 ;;1.0;TEXT INTEGRATION UTILITIES;;Jun 20, 1997
3MAKEOK ; Check out the make call
4 N ERR,DFN,VSIT,TITLE,TIUDATA,TIUI,TIUREC
5 S DFN=+$$PATIENT^TIULA Q:+DFN'>0
6 S VSIT=$$VSITPICK(DFN) Q:+VSIT'>0
7 S TITLE=$$TITLPICK Q:+TITLE'>0
8 D LOADREC(.TIUREC) S TIUI=0
9 F S TIUI=$O(TIUREC(TIUI)) Q:+TIUI'>0 D
10 . I $L($P(TIUREC(TIUI),U,2)) D
11 . . S TIUREC(TIUI)=$P($$READER(TIUREC(TIUI)),U)
12 D BLRPLT^TIUSRVD(.TIUDATA,TITLE,DFN)
13 S DIC=$P(TIUDATA,")")_",",DWPK=1 D EN^DIWE
14 M TIUREC("TEXT")=@TIUDATA K @TIUDATA
15 D MAKE^TIUSRVP(.ERR,DFN,TITLE,"","",VSIT,.TIUREC)
16 Q
17VSITPICK(DFN) ; Given a patient, select a visit
18 N DIC,X,Y
19 S DIC=9000010,DIC(0)="AEMQZ",DIC("S")="I +$P(^AUPNVSIT(+Y,0),U,5)=DFN"
20 D ^DIC K DIC("S")
21 Q +$G(Y)
22TITLPICK() ; Select a title
23 N TITLES,I,L,Y
24 D NOTES^TIUSRVD(.TITLES)
25 S (I,L,PICK)=0 F S I=$O(TITLES(I)) Q:+I'>0!+PICK D
26 . W:$E(TITLES(I))="i" !,I,?7,$P(TITLES(I),U,2)
27 . I I#20=0 S Y=$TR($P($G(TITLES(+$$PICK(1,I))),U),"i",""),PICK=+Y
28 . S L=I
29 I 'PICK S Y=$TR($P($G(TITLES(+$$PICK(1,L))),U),"i","")
30 Q $G(Y)
31PICK(LOW,HIGH) ; List selection
32 N X,Y
33 W !
34 S Y=$$READ^TIUU("LO^"_LOW_":"_HIGH,"Select Item")
35 W !
36 Q Y
37LOADREC(TIUREC) ; Load TIUREC for editing
38 S TIUREC(1202)=1202_U_$$PERSNAME^TIULC1(DUZ)
39 S TIUREC(1301)=1301_U_$$DATE^TIULS($$NOW^TIULC,"AMTH DD, CCYY@HR:MIN")
40 Q
41UPDATEOK ; Check out update call
42 N TIUX,TIUY,ERR,TIUDA,DFN,TIUEDIT,DR,TIUREC S DFN=+$$PATIENT^TIULA
43 D SELPAT^TIULA2(.TIUY,3,DFN)
44 I $D(TIUY)'>9 Q
45 S TIUDA=+$G(TIUY(1)),DR="1202;1301"
46 D GET4EDIT^TIUSRVR(.TIUREC,TIUDA,DR)
47 S TIUEDIT=$$CANDO^TIULP(TIUDA,"EDIT RECORD")
48 I +TIUEDIT'>0 W !,$C(7),$C(7),$P(TIUEDIT,U,2) Q
49 D EDIT(TIUDA,.TIUREC)
50 D UPDATE^TIUSRVP(.ERR,TIUDA,.TIUREC)
51 D EN^TIUAUDIT
52 Q
53EDIT(DA,TIUREC) ; Call ^DIE and ^DIWE to edit the text
54 N DIE,DR,TIUI,TIUFLD K ^TMP("TIUEDIT",$J)
55 N DIWESUB,DIWPT,DWHD,DWI,DWLC,DWLR,DWLW,DWO,DWPK
56 D LOADTMP(.TIUREC) S TIUI=0
57 F S TIUI=$O(TIUREC(TIUI)) Q:+TIUI'>0 D
58 . I $L($P(TIUREC(TIUI),U,2)) D
59 . . S TIUREC(TIUI)=$P($$READER(TIUREC(TIUI)),U)
60 S DIC="^TMP(""TIUEDIT"",$J,",DWPK=1 D EN^DIWE
61 M TIUREC("TEXT")=^TMP("TIUEDIT",$J) K ^TMP("TIUEDIT",$J)
62 Q
63LOADTMP(TIUREC) ; Load Text into ^TMP("TIUEDIT",$J)
64 N TIUL,TIUI S (TIUI,TIUL)=0
65 F S TIUI=$O(TIUREC("TEXT",TIUI)) Q:+TIUI'>0 D
66 . S ^TMP("TIUEDIT",$J,TIUI,0)=$G(TIUREC("TEXT",TIUI,0))
67 . S TIUL=+$G(TIUL)+1
68 S ^TMP("TIUEDIT",$J,0)="^^"_TIUL_U_TIUL_U_DT_U
69 Q
70READER(TIUREC) ; Edit each field
71 N TIUY
72 S TIUY=$$READ^TIUU("8925,"_$P(TIUREC,U),"",$P(TIUREC,U,2))
73 Q $G(TIUY)
74DELETOK ; Check out DELETE API
75 N ERR,TIUDA,DFN S DFN=+$$PATIENT^TIULA
76 D SELPAT^TIULA2(.TIUY,38,DFN)
77 I $D(TIUY)'>9 Q
78 S TIUDA=+$G(TIUY(1))
79 D DELETE^TIUSRVP(.ERR,TIUDA)
80 I ERR W !,ERR
81 Q
82ADDNOK ; Check CREATE ADDENDUM API
83 N TIUDADD,TIUDAT,TIUDA,TIUI,DFN,TIUDATA,TIUREC
84 S DFN=+$$PATIENT^TIULA
85 D SELPAT^TIULA2(.TIUDAT,3,DFN)
86 I +$G(TIUDAT)'>0,($D(TIUDAT)'>9) D S TIUOUT=1 Q
87 . W !!,"Nothing selected."
88 S TIUI=0
89 F S TIUI=$O(TIUDAT(TIUI)) Q:+TIUI'>0 D
90 . N TIUJ
91 . S TIUDA=+$G(TIUDAT(TIUI)) Q:+TIUDA'>0
92 . D LOADREC(.TIUREC) S TIUJ=0
93 . F S TIUJ=$O(TIUREC(TIUJ)) Q:+TIUJ'>0 D
94 . . I $L($P(TIUREC(TIUJ),U,2)) D
95 . . . S TIUREC(TIUJ)=$P($$READER(TIUREC(TIUJ)),U)
96 . D BLRPLT^TIUSRVD(.TIUDATA,81,DFN)
97 . S DIC=$P(TIUDATA,")")_",",DWPK=1 D EN^DIWE
98 . M TIUREC("TEXT")=@TIUDATA K @TIUDATA
99 . D MAKEADD^TIUSRVP(.TIUDADD,TIUDA,.TIUREC)
100 Q
Note: See TracBrowser for help on using the repository browser.