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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUAPIOK 3450 printed Apr 09, 2024@21:46:43 Page 2
TIUAPIOK ; SLC/JER - Check out PUT API's
+1 ;;1.0;TEXT INTEGRATION UTILITIES;;Jun 20, 1997
MAKEOK ; Check out the make call
+1 NEW ERR,DFN,VSIT,TITLE,TIUDATA,TIUI,TIUREC
+2 SET DFN=+$$PATIENT^TIULA
if +DFN'>0
QUIT
+3 SET VSIT=$$VSITPICK(DFN)
if +VSIT'>0
QUIT
+4 SET TITLE=$$TITLPICK
if +TITLE'>0
QUIT
+5 DO LOADREC(.TIUREC)
SET TIUI=0
+6 FOR
SET TIUI=$ORDER(TIUREC(TIUI))
if +TIUI'>0
QUIT
Begin DoDot:1
+7 IF $LENGTH($PIECE(TIUREC(TIUI),U,2))
Begin DoDot:2
+8 SET TIUREC(TIUI)=$PIECE($$READER(TIUREC(TIUI)),U)
End DoDot:2
End DoDot:1
+9 DO BLRPLT^TIUSRVD(.TIUDATA,TITLE,DFN)
+10 SET DIC=$PIECE(TIUDATA,")")_","
SET DWPK=1
DO EN^DIWE
+11 MERGE TIUREC("TEXT")=@TIUDATA
KILL @TIUDATA
+12 DO MAKE^TIUSRVP(.ERR,DFN,TITLE,"","",VSIT,.TIUREC)
+13 QUIT
VSITPICK(DFN) ; Given a patient, select a visit
+1 NEW DIC,X,Y
+2 SET DIC=9000010
SET DIC(0)="AEMQZ"
SET DIC("S")="I +$P(^AUPNVSIT(+Y,0),U,5)=DFN"
+3 DO ^DIC
KILL DIC("S")
+4 QUIT +$GET(Y)
TITLPICK() ; Select a title
+1 NEW TITLES,I,L,Y
+2 DO NOTES^TIUSRVD(.TITLES)
+3 SET (I,L,PICK)=0
FOR
SET I=$ORDER(TITLES(I))
if +I'>0!+PICK
QUIT
Begin DoDot:1
+4 if $EXTRACT(TITLES(I))="i"
WRITE !,I,?7,$PIECE(TITLES(I),U,2)
+5 IF I#20=0
SET Y=$TRANSLATE($PIECE($GET(TITLES(+$$PICK(1,I))),U),"i","")
SET PICK=+Y
+6 SET L=I
End DoDot:1
+7 IF 'PICK
SET Y=$TRANSLATE($PIECE($GET(TITLES(+$$PICK(1,L))),U),"i","")
+8 QUIT $GET(Y)
PICK(LOW,HIGH) ; List selection
+1 NEW X,Y
+2 WRITE !
+3 SET Y=$$READ^TIUU("LO^"_LOW_":"_HIGH,"Select Item")
+4 WRITE !
+5 QUIT Y
LOADREC(TIUREC) ; Load TIUREC for editing
+1 SET TIUREC(1202)=1202_U_$$PERSNAME^TIULC1(DUZ)
+2 SET TIUREC(1301)=1301_U_$$DATE^TIULS($$NOW^TIULC,"AMTH DD, CCYY@HR:MIN")
+3 QUIT
UPDATEOK ; Check out update call
+1 NEW TIUX,TIUY,ERR,TIUDA,DFN,TIUEDIT,DR,TIUREC
SET DFN=+$$PATIENT^TIULA
+2 DO SELPAT^TIULA2(.TIUY,3,DFN)
+3 IF $DATA(TIUY)'>9
QUIT
+4 SET TIUDA=+$GET(TIUY(1))
SET DR="1202;1301"
+5 DO GET4EDIT^TIUSRVR(.TIUREC,TIUDA,DR)
+6 SET TIUEDIT=$$CANDO^TIULP(TIUDA,"EDIT RECORD")
+7 IF +TIUEDIT'>0
WRITE !,$CHAR(7),$CHAR(7),$PIECE(TIUEDIT,U,2)
QUIT
+8 DO EDIT(TIUDA,.TIUREC)
+9 DO UPDATE^TIUSRVP(.ERR,TIUDA,.TIUREC)
+10 DO EN^TIUAUDIT
+11 QUIT
EDIT(DA,TIUREC) ; Call ^DIE and ^DIWE to edit the text
+1 NEW DIE,DR,TIUI,TIUFLD
KILL ^TMP("TIUEDIT",$JOB)
+2 NEW DIWESUB,DIWPT,DWHD,DWI,DWLC,DWLR,DWLW,DWO,DWPK
+3 DO LOADTMP(.TIUREC)
SET TIUI=0
+4 FOR
SET TIUI=$ORDER(TIUREC(TIUI))
if +TIUI'>0
QUIT
Begin DoDot:1
+5 IF $LENGTH($PIECE(TIUREC(TIUI),U,2))
Begin DoDot:2
+6 SET TIUREC(TIUI)=$PIECE($$READER(TIUREC(TIUI)),U)
End DoDot:2
End DoDot:1
+7 SET DIC="^TMP(""TIUEDIT"",$J,"
SET DWPK=1
DO EN^DIWE
+8 MERGE TIUREC("TEXT")=^TMP("TIUEDIT",$JOB)
KILL ^TMP("TIUEDIT",$JOB)
+9 QUIT
LOADTMP(TIUREC) ; Load Text into ^TMP("TIUEDIT",$J)
+1 NEW TIUL,TIUI
SET (TIUI,TIUL)=0
+2 FOR
SET TIUI=$ORDER(TIUREC("TEXT",TIUI))
if +TIUI'>0
QUIT
Begin DoDot:1
+3 SET ^TMP("TIUEDIT",$JOB,TIUI,0)=$GET(TIUREC("TEXT",TIUI,0))
+4 SET TIUL=+$GET(TIUL)+1
End DoDot:1
+5 SET ^TMP("TIUEDIT",$JOB,0)="^^"_TIUL_U_TIUL_U_DT_U
+6 QUIT
READER(TIUREC) ; Edit each field
+1 NEW TIUY
+2 SET TIUY=$$READ^TIUU("8925,"_$PIECE(TIUREC,U),"",$PIECE(TIUREC,U,2))
+3 QUIT $GET(TIUY)
DELETOK ; Check out DELETE API
+1 NEW ERR,TIUDA,DFN
SET DFN=+$$PATIENT^TIULA
+2 DO SELPAT^TIULA2(.TIUY,38,DFN)
+3 IF $DATA(TIUY)'>9
QUIT
+4 SET TIUDA=+$GET(TIUY(1))
+5 DO DELETE^TIUSRVP(.ERR,TIUDA)
+6 IF ERR
WRITE !,ERR
+7 QUIT
ADDNOK ; Check CREATE ADDENDUM API
+1 NEW TIUDADD,TIUDAT,TIUDA,TIUI,DFN,TIUDATA,TIUREC
+2 SET DFN=+$$PATIENT^TIULA
+3 DO SELPAT^TIULA2(.TIUDAT,3,DFN)
+4 IF +$GET(TIUDAT)'>0
IF ($DATA(TIUDAT)'>9)
Begin DoDot:1
+5 WRITE !!,"Nothing selected."
End DoDot:1
SET TIUOUT=1
QUIT
+6 SET TIUI=0
+7 FOR
SET TIUI=$ORDER(TIUDAT(TIUI))
if +TIUI'>0
QUIT
Begin DoDot:1
+8 NEW TIUJ
+9 SET TIUDA=+$GET(TIUDAT(TIUI))
if +TIUDA'>0
QUIT
+10 DO LOADREC(.TIUREC)
SET TIUJ=0
+11 FOR
SET TIUJ=$ORDER(TIUREC(TIUJ))
if +TIUJ'>0
QUIT
Begin DoDot:2
+12 IF $LENGTH($PIECE(TIUREC(TIUJ),U,2))
Begin DoDot:3
+13 SET TIUREC(TIUJ)=$PIECE($$READER(TIUREC(TIUJ)),U)
End DoDot:3
End DoDot:2
+14 DO BLRPLT^TIUSRVD(.TIUDATA,81,DFN)
+15 SET DIC=$PIECE(TIUDATA,")")_","
SET DWPK=1
DO EN^DIWE
+16 MERGE TIUREC("TEXT")=@TIUDATA
KILL @TIUDATA
+17 DO MAKEADD^TIUSRVP(.TIUDADD,TIUDA,.TIUREC)
End DoDot:1
+18 QUIT
