VistA-FOIAVistA/r/TEXT_INTEGRATION_UTILITIES-.../TIUAPIOK.m

101 lines
3.3 KiB
Mathematica

TIUAPIOK ; SLC/JER - Check out PUT API's
;;1.0;TEXT INTEGRATION UTILITIES;;Jun 20, 1997
MAKEOK ; Check out the make call
N ERR,DFN,VSIT,TITLE,TIUDATA,TIUI,TIUREC
S DFN=+$$PATIENT^TIULA Q:+DFN'>0
S VSIT=$$VSITPICK(DFN) Q:+VSIT'>0
S TITLE=$$TITLPICK Q:+TITLE'>0
D LOADREC(.TIUREC) S TIUI=0
F S TIUI=$O(TIUREC(TIUI)) Q:+TIUI'>0 D
. I $L($P(TIUREC(TIUI),U,2)) D
. . S TIUREC(TIUI)=$P($$READER(TIUREC(TIUI)),U)
D BLRPLT^TIUSRVD(.TIUDATA,TITLE,DFN)
S DIC=$P(TIUDATA,")")_",",DWPK=1 D EN^DIWE
M TIUREC("TEXT")=@TIUDATA K @TIUDATA
D MAKE^TIUSRVP(.ERR,DFN,TITLE,"","",VSIT,.TIUREC)
Q
VSITPICK(DFN) ; Given a patient, select a visit
N DIC,X,Y
S DIC=9000010,DIC(0)="AEMQZ",DIC("S")="I +$P(^AUPNVSIT(+Y,0),U,5)=DFN"
D ^DIC K DIC("S")
Q +$G(Y)
TITLPICK() ; Select a title
N TITLES,I,L,Y
D NOTES^TIUSRVD(.TITLES)
S (I,L,PICK)=0 F S I=$O(TITLES(I)) Q:+I'>0!+PICK D
. W:$E(TITLES(I))="i" !,I,?7,$P(TITLES(I),U,2)
. I I#20=0 S Y=$TR($P($G(TITLES(+$$PICK(1,I))),U),"i",""),PICK=+Y
. S L=I
I 'PICK S Y=$TR($P($G(TITLES(+$$PICK(1,L))),U),"i","")
Q $G(Y)
PICK(LOW,HIGH) ; List selection
N X,Y
W !
S Y=$$READ^TIUU("LO^"_LOW_":"_HIGH,"Select Item")
W !
Q Y
LOADREC(TIUREC) ; Load TIUREC for editing
S TIUREC(1202)=1202_U_$$PERSNAME^TIULC1(DUZ)
S TIUREC(1301)=1301_U_$$DATE^TIULS($$NOW^TIULC,"AMTH DD, CCYY@HR:MIN")
Q
UPDATEOK ; Check out update call
N TIUX,TIUY,ERR,TIUDA,DFN,TIUEDIT,DR,TIUREC S DFN=+$$PATIENT^TIULA
D SELPAT^TIULA2(.TIUY,3,DFN)
I $D(TIUY)'>9 Q
S TIUDA=+$G(TIUY(1)),DR="1202;1301"
D GET4EDIT^TIUSRVR(.TIUREC,TIUDA,DR)
S TIUEDIT=$$CANDO^TIULP(TIUDA,"EDIT RECORD")
I +TIUEDIT'>0 W !,$C(7),$C(7),$P(TIUEDIT,U,2) Q
D EDIT(TIUDA,.TIUREC)
D UPDATE^TIUSRVP(.ERR,TIUDA,.TIUREC)
D EN^TIUAUDIT
Q
EDIT(DA,TIUREC) ; Call ^DIE and ^DIWE to edit the text
N DIE,DR,TIUI,TIUFLD K ^TMP("TIUEDIT",$J)
N DIWESUB,DIWPT,DWHD,DWI,DWLC,DWLR,DWLW,DWO,DWPK
D LOADTMP(.TIUREC) S TIUI=0
F S TIUI=$O(TIUREC(TIUI)) Q:+TIUI'>0 D
. I $L($P(TIUREC(TIUI),U,2)) D
. . S TIUREC(TIUI)=$P($$READER(TIUREC(TIUI)),U)
S DIC="^TMP(""TIUEDIT"",$J,",DWPK=1 D EN^DIWE
M TIUREC("TEXT")=^TMP("TIUEDIT",$J) K ^TMP("TIUEDIT",$J)
Q
LOADTMP(TIUREC) ; Load Text into ^TMP("TIUEDIT",$J)
N TIUL,TIUI S (TIUI,TIUL)=0
F S TIUI=$O(TIUREC("TEXT",TIUI)) Q:+TIUI'>0 D
. S ^TMP("TIUEDIT",$J,TIUI,0)=$G(TIUREC("TEXT",TIUI,0))
. S TIUL=+$G(TIUL)+1
S ^TMP("TIUEDIT",$J,0)="^^"_TIUL_U_TIUL_U_DT_U
Q
READER(TIUREC) ; Edit each field
N TIUY
S TIUY=$$READ^TIUU("8925,"_$P(TIUREC,U),"",$P(TIUREC,U,2))
Q $G(TIUY)
DELETOK ; Check out DELETE API
N ERR,TIUDA,DFN S DFN=+$$PATIENT^TIULA
D SELPAT^TIULA2(.TIUY,38,DFN)
I $D(TIUY)'>9 Q
S TIUDA=+$G(TIUY(1))
D DELETE^TIUSRVP(.ERR,TIUDA)
I ERR W !,ERR
Q
ADDNOK ; Check CREATE ADDENDUM API
N TIUDADD,TIUDAT,TIUDA,TIUI,DFN,TIUDATA,TIUREC
S DFN=+$$PATIENT^TIULA
D SELPAT^TIULA2(.TIUDAT,3,DFN)
I +$G(TIUDAT)'>0,($D(TIUDAT)'>9) D S TIUOUT=1 Q
. W !!,"Nothing selected."
S TIUI=0
F S TIUI=$O(TIUDAT(TIUI)) Q:+TIUI'>0 D
. N TIUJ
. S TIUDA=+$G(TIUDAT(TIUI)) Q:+TIUDA'>0
. D LOADREC(.TIUREC) S TIUJ=0
. F S TIUJ=$O(TIUREC(TIUJ)) Q:+TIUJ'>0 D
. . I $L($P(TIUREC(TIUJ),U,2)) D
. . . S TIUREC(TIUJ)=$P($$READER(TIUREC(TIUJ)),U)
. D BLRPLT^TIUSRVD(.TIUDATA,81,DFN)
. S DIC=$P(TIUDATA,")")_",",DWPK=1 D EN^DIWE
. M TIUREC("TEXT")=@TIUDATA K @TIUDATA
. D MAKEADD^TIUSRVP(.TIUDADD,TIUDA,.TIUREC)
Q