Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: TIUAPIOK

TIUAPIOK.m

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