- 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 Feb 19, 2025@00:05:21 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