source: FOIAVistA/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUAPIOK.m@ 794

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