- TIUBR1 ;SLC/JER - Enter TIU Browse with DFN and TIUDA ;8/21/01 [12/15/04 9:18am]
- ;;1.0;TEXT INTEGRATION UTILITIES;**31,100,123,176,157,241**;Jun 20, 1997;Build 7
- ; Move LOADSIG, XTRASIG, LOADFOR, LOADREC from TIUBR. **100**
- ;
- LOADREC(TIUDA,TIUL,TIUGDATA,TIUGWHOL) ; Load ^TMP
- ;Requires TIUDA, array TIUL, TIUGDATA
- ;Optional TIUGWHOL = 1 if we're mid-load for browse, and we're already
- ; loading the whole note after the selected child,
- ; so DON'T load the whole note again.
- N TIUKID,TIUI,CANSEE,TIUPARNT,TIUPNAME,TIUPDATE
- N TIUGPRNT,TIUPDATA,TIUHASKD
- S TIUI=0
- ; ---- If user cannot view TIUDA, say so,
- ; [load the rest of the ID note], & quit: ----
- S CANSEE=$S(+$$ISCOMP^TIUBR(TIUDA)>0:1,1:$$CANDO^TIULP(+TIUDA,"VIEW"))
- I +CANSEE'>0 D Q
- . S TIUL=+$G(TIUL)+1
- . S @VALMAR@(TIUL,0)=$P(CANSEE,U,2)
- . I $P(TIUGDATA,U,2)!$P(TIUGDATA,U,3) D IDREST(TIUDA,.TIUL,TIUGDATA,.TIUGWHOL)
- ; ---- Load text of TIUDA: ----
- F S TIUI=$O(^TIU(8925,+TIUDA,"TEXT",TIUI)) Q:+TIUI'>0 D
- . S TIUL=+$G(TIUL)+1
- . S @VALMAR@(TIUL,0)=$G(^TIU(8925,+TIUDA,"TEXT",+TIUI,0))
- ; ---- If TIUDA is a COMPONENT, QUIT
- Q:+$$ISCOMP^TIUBR(TIUDA)
- ; ---- If TIUDA **IS** an addendum, load addm signature,
- ; load original document, quit: ----
- I +$$ISADDNDM^TIULC1(+TIUDA) D Q
- . N TIULINE S $P(TIULINE,"=",79)=""
- . D LOADSIG(TIUDA,.TIUL)
- . S TIUL=+$G(TIUL)+1,@VALMAR@(TIUL,0)=""
- . S TIUL=+$G(TIUL)+1,@VALMAR@(TIUL,0)=TIULINE
- . S TIUL=+$G(TIUL)+1,@VALMAR@(TIUL,0)=""
- . S TIUPARNT=+$P(^TIU(8925,+TIUDA,0),U,6)
- . S TIUPNAME=$$PNAME^TIULC1(+^TIU(8925,TIUPARNT,0))
- . S TIUPDATE=+$G(^TIU(8925,TIUPARNT,13))
- . S TIUPDATE=$$DATE^TIULS(TIUPDATE,"MM/DD/YY")
- . S TIUPDATA=$$IDDATA^TIURECL1(TIUPARNT)
- . S TIUHASKD=$P(TIUPDATA,U,2),TIUGPRNT=+$P(TIUPDATA,U,3)
- . S TIUL=+$G(TIUL)+1
- . I 'TIUHASKD,'TIUGPRNT D
- . . S @VALMAR@(TIUL,0)=" --- Original Document ---"
- . . S TIUL=+$G(TIUL)+1,@VALMAR@(TIUL,0)=""
- . . S TIUL=+$G(TIUL)+1
- . . S @VALMAR@(TIUL,0)=TIUPDATE_" "_TIUPNAME_":"
- . . D LOADREC(TIUPARNT,.TIUL,TIUGDATA)
- . I TIUHASKD D
- . . S @VALMAR@(TIUL,0)=" --- Addended Interdisciplinary Note ---"
- . . D LOADID^TIUGBR(TIUPARNT,.TIUL,TIUPDATA,1)
- . I TIUGPRNT D
- . . S @VALMAR@(TIUL,0)=" --- Original Interdisciplinary Entry ---"
- . . S TIUL=+$G(TIUL)+1,@VALMAR@(TIUL,0)=""
- . . S TIUL=+$G(TIUL)+1
- . . S @VALMAR@(TIUL,0)=TIUPDATE_" "_TIUPNAME_":"
- . . D LOADREC(TIUPARNT,.TIUL,TIUGDATA)
- . . S TIUL=+$G(TIUL)+1,@VALMAR@(TIUL,0)=""
- . . S TIUL=+$G(TIUL)+1
- . . S @VALMAR@(TIUL,0)=" --- Interdisciplinary Note ---"
- . . D LOADID^TIUGBR(TIUGPRNT,.TIUL,TIUPDATA,1)
- ; ---- Load components of TIUDA: ----
- S TIUKID=0
- F S TIUKID=$O(^TIU(8925,"DAD",+TIUDA,TIUKID)) Q:+TIUKID'>0 D
- . I +$$ISADDNDM^TIULC1(TIUKID)'>0 D LOADREC(TIUKID,.TIUL,TIUGDATA)
- ; ---- Load signature of TIUDA if TIUDA is not addm
- ; or comp: ----
- I '$$ISCOMP^TIUBR(TIUDA) D LOADSIG(TIUDA,.TIUL)
- ; ---- Load addenda of TIUDA: ----
- S TIUKID=0
- F S TIUKID=$O(^TIU(8925,"DAD",+TIUDA,TIUKID)) Q:+TIUKID'>0 D
- . ; If an addendum has focus, don't show it again unless
- . ; loading whole ID note:
- . I '$G(TIUGWHOL),+TIUKID=+$G(^TMP("TIU FOCUS",$J)) Q
- . I +$$ISADDNDM^TIULC1(TIUKID) D LOADADD^TIUBR(TIUKID,.TIUL)
- ; ---- Load the rest of the ID note display: ----
- I $P(TIUGDATA,U,2)!$P(TIUGDATA,U,3) D IDREST(TIUDA,.TIUL,TIUGDATA,.TIUGWHOL)
- Q
- ;
- IDREST(TIUDA,TIUL,TIUGDATA,TIUGWHOL) ; Load rest of ID note display
- N IDDAD
- S IDDAD=+$P(TIUGDATA,U,3)
- ; ---- If Browsed Record is an ID child, & this cycle hasn't begun
- ; loading the whole note, then load the whole ID Note after
- ; the browsed child: ----
- I IDDAD,'$G(TIUGWHOL) D Q
- . S TIUGWHOL=1
- . N TIULINE S $P(TIULINE,"=",79)=""
- . S TIUL=+$G(TIUL)+1,@VALMAR@(TIUL,0)=""
- . S TIUL=+$G(TIUL)+1,@VALMAR@(TIUL,0)=TIULINE
- . S TIUL=+$G(TIUL)+1,@VALMAR@(TIUL,0)=""
- . S TIUL=+$G(TIUL)+1,@VALMAR@(TIUL,0)=" --- Interdisciplinary Note ---"
- . D LOADID^TIUGBR(IDDAD,.TIUL,TIUGDATA,TIUGWHOL)
- ; ---- If Browsed Record is an ID parent, & this cycle has
- ; just loaded the parent entry, OR
- ; If Browsed Record is an ID child, & this cycle has begun
- ; loading the whole ID note, and is currently loading the first
- ; entry of the whole note,
- ; Then load kids: ----
- I $P(TIUGDATA,U,2)&(TIUDA=+TIUGDATA)!(IDDAD&$G(TIUGWHOL)&(TIUDA=IDDAD)) D
- . D LOADKIDS^TIUBR(TIUDA,.TIUL,TIUGDATA,$G(TIUGWHOL)) K TIUGWHOL
- . S TIUL=+$G(TIUL)+1,@VALMAR@(TIUL,0)=""
- . S TIUL=+$G(TIUL)+1,@VALMAR@(TIUL,0)=" << Interdisciplinary Note - End >>"
- Q
- EXSTNOTE(DFN,TIUDA) ; Sample/display existing notes
- N TIU,TIUPRM0,TIUPRM1,TIUSEE,TIUOUT,TIUY,TIUQUIT
- D SETPARM^TIULE
- Q:TIUDA'>0
- D GETTIU^TIULD(.TIU,+TIUDA)
- I $D(TIU) D
- . S TIUSEE=$$CANDO^TIULP(TIUDA,"VIEW")
- . I 'TIUSEE D Q
- . . W !!,$C(7),$P(TIUSEE,U,2),!
- . . W:$$READ^TIUU("FOA","Press RETURN to continue...") ""
- . D EN^VALM("TIU BROWSE FOR CLINICIAN")
- . K ^TMP("TIUVIEW",$J)
- . S:$D(TIUQUIT) TIUOUT=1
- Q
- ;
- LOADSIG(DA,TIUL) ; Get signature and co-signature blocks
- N DIC,DIQ,DR,TIUSIG,TIUESIG1,TIUESIG2,TIUSIG1,TIUSIG2,TIUS1,TIUS2
- N TIUSNM,TIUSTTL,TIUS1DT,TIUS2DT,TIUSDT
- ;VMP/ELR CHANGED NEXT LINE FROM QUIT IF NOT DEFINED TO GO TO XTRA
- I '$D(^TIU(8925,DA,15)) G XTRA
- S DIC=8925,DIQ="TIUSIG(",DIQ(0)="IE",DR="1204;1208;1501:1505;1507:1513;1601:1605"
- D EN^DIQ1 I '$D(TIUSIG) Q
- S TIUS1=$S(TIUSIG(8925,DA,1505,"I")="E":"/es/ ",TIUSIG(8925,DA,1505,"I")="C":"/s/ ",1:"")_$G(TIUSIG(8925,DA,1503,"E"))
- S TIUS2=$S(TIUSIG(8925,DA,1511,"I")="E":"/es/ ",TIUSIG(8925,DA,1511,"I")="C":"/s/ ",1:"")_$G(TIUSIG(8925,DA,1509,"E"))
- S TIUESIG1=$G(TIUSIG(8925,DA,1204,"I"))
- S TIUSIG1=$G(TIUSIG(8925,DA,1502,"I"))
- S TIUS1DT=$S(+$G(TIUSIG(8925,DA,1501,"I")):"Signed: "_$$DATE^TIULS($G(TIUSIG(8925,DA,1501,"I")),"MM/DD/CCYY HR:MIN"),1:"")
- S TIUESIG2=$G(TIUSIG(8925,DA,1208,"I"))
- S TIUS2DT=$S(+$G(TIUSIG(8925,DA,1507,"I")):"Cosigned: "_$$DATE^TIULS($G(TIUSIG(8925,DA,1507,"I")),"MM/DD/CCYY HR:MIN"),1:"")
- S TIUSIG2=$G(TIUSIG(8925,DA,1508,"I"))
- S TIUL=+$G(TIUL)+1,@VALMAR@(TIUL,0)=" "
- S TIUL=+$G(TIUL)+1,@VALMAR@(TIUL,0)=TIUS1
- S TIUL=+$G(TIUL)+1,@VALMAR@(TIUL,0)=$G(TIUSIG(8925,DA,1504,"E"))
- S TIUL=+$G(TIUL)+1,@VALMAR@(TIUL,0)=TIUS1DT
- I $G(TIUSIG(8925,DA,1505,"I"))="C" D
- . N TIUONCH
- . S TIUONCH=$G(TIUSIG(8925,DA,1512,"E")) I '$L(TIUONCH) S TIUONCH=$G(TIUSIG(8925,DA,1513,"E"))
- . S TIUL=+$G(TIUL)+1,@VALMAR@(TIUL,0)="Marked signed on chart by: "_TIUONCH
- I TIUSIG1]"",(TIUSIG1'=TIUESIG1) D LOADFOR(TIUSIG1,TIUESIG1,.TIUL)
- I +$G(TIUSIG(8925,DA,1507,"I"))>0 D
- . S TIUL=+$G(TIUL)+1,@VALMAR@(TIUL,0)=" "
- . S TIUL=+$G(TIUL)+1,@VALMAR@(TIUL,0)=TIUS2
- . S TIUL=+$G(TIUL)+1,@VALMAR@(TIUL,0)=$G(TIUSIG(8925,DA,1510,"E"))
- . S TIUL=+$G(TIUL)+1,@VALMAR@(TIUL,0)=TIUS2DT
- . I $G(TIUSIG(8925,DA,1511,"I"))="C" D
- . . S TIUL=+$G(TIUL)+1,@VALMAR@(TIUL,0)="Marked cosigned on chart by: "_$G(TIUSIG(8925,DA,1513,"E"))
- I TIUSIG2]"",(TIUSIG2'=TIUESIG2) D LOADFOR(TIUSIG2,TIUESIG2,.TIUL)
- XTRA I +$O(^TIU(8925.7,"B",DA,0)) D XTRASIG(DA,.TIUL)
- I +$G(TIUSIG(8925,DA,1601,"I")) D
- . N TIUMODE
- . S TIUL=+$G(TIUL)+1,@VALMAR@(TIUL,0)=""
- . S TIUL=+$G(TIUL)+1
- . S @VALMAR@(TIUL,0)=$$DATE^TIULS(TIUSIG(8925,DA,1601,"I"),"MM/DD/CCYY HR:MIN")_" AMENDMENT FILED:"
- . S TIUL=+$G(TIUL)+1,@VALMAR@(TIUL,0)="",TIUL=+$G(TIUL)+1
- . S TIUMODE=$S(+$G(TIUSIG(8925,DA,1603,"I")):"/es/ ",1:" /s/ ")
- . S @VALMAR@(TIUL,0)=TIUMODE_$S($G(TIUSIG(8925,DA,1604,"E"))]"":$G(TIUSIG(8925,DA,1604,"E")),1:$G(TIUSIG(8925,DA,1602,"E")))
- . I $L($G(TIUSIG(8925,DA,1605,"E"))) D
- . . S TIUL=+$G(TIUL)+1,@VALMAR@(TIUL,0)=$G(TIUSIG(8925,DA,1605,"E"))
- . S TIUL=+$G(TIUL)+1,@VALMAR@(TIUL,0)=$P($G(TIUPRM1),U,5)
- Q
- XTRASIG(TIUDA,TIUL) ; Load additional signature blocks
- N TIUI,DA,DR,DIC,DIQ,TIUXTRA S TIUI=0
- S DIC="^TIU(8925.7,",DIQ="TIUXTRA"
- S TIUL=+$G(TIUL)+1,@VALMAR@(TIUL,0)=" "
- S TIUL=+$G(TIUL)+1,@VALMAR@(TIUL,0)="Receipt Acknowledged By:"
- F S TIUI=$O(^TIU(8925.7,"B",TIUDA,TIUI)) Q:+TIUI'>0 D
- . N TIUX,TIUSGNR,TIUSDT
- . S DA=TIUI,DR=".03:.08",DIQ(0)="IE" D EN^DIQ1 Q:+$D(TIUXTRA)'>9
- . S TIUSGNR=$S($L($G(TIUXTRA(8925.7,DA,.06,"E"))):"/es/ "_$G(TIUXTRA(8925.7,DA,.06,"E")),1:" "_$G(TIUXTRA(8925.7,DA,.03,"E")))
- . S TIUSDT=$S(+$G(TIUXTRA(8925.7,DA,.04,"I")):$$DATE^TIULS(TIUXTRA(8925.7,DA,.04,"I"),"MM/DD/CCYY HR:MIN"),1:"* AWAITING SIGNATURE *")
- . S TIUX=$$SETSTR^VALM1(TIUSDT,$G(TIUX),1,38)
- . S TIUX=$$SETSTR^VALM1(TIUSGNR,$G(TIUX),25,55)
- . S TIUL=+$G(TIUL)+1,@VALMAR@(TIUL,0)=TIUX,TIUX=""
- . S TIUX=$$SETSTR^VALM1($G(TIUXTRA(8925.7,DA,.07,"E")),$G(TIUX),30,50)
- . S TIUL=+$G(TIUL)+1,@VALMAR@(TIUL,0)=TIUX
- . I $G(TIUXTRA(8925.7,DA,.05,"I")),$G(TIUXTRA(8925.7,DA,.05,"I"))'=$G(TIUXTRA(8925.7,DA,.03,"I")) D
- . . N TIUFOR
- . . S TIUX=""
- . . S TIUFOR="for "_$P($G(TIUXTRA(8925.7,DA,.03,"E")),",",2)_" "_$P($G(TIUXTRA(8925.7,DA,.03,"E")),",")
- . . S TIUX=$$SETSTR^VALM1(TIUFOR,$G(TIUX),26,55)
- . . S TIUL=TIUL+1,@VALMAR@(TIUL,0)=TIUX
- Q
- LOADFOR(TIUS1,TIUES1,TIUL) ; Apply "for" block
- N TIUESN1,TIUEST1,TIUFORN,TIUFORT
- S TIUESN1="for "_$$SIGNAME^TIULS(TIUES1),TIUEST1=$$SIGTITL^TIULS(TIUES1)
- I +$G(TIUS1),($G(TIUS1)'=$G(TIUES1)) S TIUFORN=$$SETSTR^VALM1(TIUESN1,$G(TIUFORN),1,50),TIUFORT=$$SETSTR^VALM1(TIUEST1,$G(TIUFORT),1,50)
- S TIUL=+$G(TIUL)+1,@VALMAR@(TIUL,0)=TIUFORN
- S TIUL=+$G(TIUL)+1,@VALMAR@(TIUL,0)=TIUFORT
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUBR1 9441 printed Feb 19, 2025@00:05:30 Page 2
- TIUBR1 ;SLC/JER - Enter TIU Browse with DFN and TIUDA ;8/21/01 [12/15/04 9:18am]
- +1 ;;1.0;TEXT INTEGRATION UTILITIES;**31,100,123,176,157,241**;Jun 20, 1997;Build 7
- +2 ; Move LOADSIG, XTRASIG, LOADFOR, LOADREC from TIUBR. **100**
- +3 ;
- LOADREC(TIUDA,TIUL,TIUGDATA,TIUGWHOL) ; Load ^TMP
- +1 ;Requires TIUDA, array TIUL, TIUGDATA
- +2 ;Optional TIUGWHOL = 1 if we're mid-load for browse, and we're already
- +3 ; loading the whole note after the selected child,
- +4 ; so DON'T load the whole note again.
- +5 NEW TIUKID,TIUI,CANSEE,TIUPARNT,TIUPNAME,TIUPDATE
- +6 NEW TIUGPRNT,TIUPDATA,TIUHASKD
- +7 SET TIUI=0
- +8 ; ---- If user cannot view TIUDA, say so,
- +9 ; [load the rest of the ID note], & quit: ----
- +10 SET CANSEE=$SELECT(+$$ISCOMP^TIUBR(TIUDA)>0:1,1:$$CANDO^TIULP(+TIUDA,"VIEW"))
- +11 IF +CANSEE'>0
- Begin DoDot:1
- +12 SET TIUL=+$GET(TIUL)+1
- +13 SET @VALMAR@(TIUL,0)=$PIECE(CANSEE,U,2)
- +14 IF $PIECE(TIUGDATA,U,2)!$PIECE(TIUGDATA,U,3)
- DO IDREST(TIUDA,.TIUL,TIUGDATA,.TIUGWHOL)
- End DoDot:1
- QUIT
- +15 ; ---- Load text of TIUDA: ----
- +16 FOR
- SET TIUI=$ORDER(^TIU(8925,+TIUDA,"TEXT",TIUI))
- if +TIUI'>0
- QUIT
- Begin DoDot:1
- +17 SET TIUL=+$GET(TIUL)+1
- +18 SET @VALMAR@(TIUL,0)=$GET(^TIU(8925,+TIUDA,"TEXT",+TIUI,0))
- End DoDot:1
- +19 ; ---- If TIUDA is a COMPONENT, QUIT
- +20 if +$$ISCOMP^TIUBR(TIUDA)
- QUIT
- +21 ; ---- If TIUDA **IS** an addendum, load addm signature,
- +22 ; load original document, quit: ----
- +23 IF +$$ISADDNDM^TIULC1(+TIUDA)
- Begin DoDot:1
- +24 NEW TIULINE
- SET $PIECE(TIULINE,"=",79)=""
- +25 DO LOADSIG(TIUDA,.TIUL)
- +26 SET TIUL=+$GET(TIUL)+1
- SET @VALMAR@(TIUL,0)=""
- +27 SET TIUL=+$GET(TIUL)+1
- SET @VALMAR@(TIUL,0)=TIULINE
- +28 SET TIUL=+$GET(TIUL)+1
- SET @VALMAR@(TIUL,0)=""
- +29 SET TIUPARNT=+$PIECE(^TIU(8925,+TIUDA,0),U,6)
- +30 SET TIUPNAME=$$PNAME^TIULC1(+^TIU(8925,TIUPARNT,0))
- +31 SET TIUPDATE=+$GET(^TIU(8925,TIUPARNT,13))
- +32 SET TIUPDATE=$$DATE^TIULS(TIUPDATE,"MM/DD/YY")
- +33 SET TIUPDATA=$$IDDATA^TIURECL1(TIUPARNT)
- +34 SET TIUHASKD=$PIECE(TIUPDATA,U,2)
- SET TIUGPRNT=+$PIECE(TIUPDATA,U,3)
- +35 SET TIUL=+$GET(TIUL)+1
- +36 IF 'TIUHASKD
- IF 'TIUGPRNT
- Begin DoDot:2
- +37 SET @VALMAR@(TIUL,0)=" --- Original Document ---"
- +38 SET TIUL=+$GET(TIUL)+1
- SET @VALMAR@(TIUL,0)=""
- +39 SET TIUL=+$GET(TIUL)+1
- +40 SET @VALMAR@(TIUL,0)=TIUPDATE_" "_TIUPNAME_":"
- +41 DO LOADREC(TIUPARNT,.TIUL,TIUGDATA)
- End DoDot:2
- +42 IF TIUHASKD
- Begin DoDot:2
- +43 SET @VALMAR@(TIUL,0)=" --- Addended Interdisciplinary Note ---"
- +44 DO LOADID^TIUGBR(TIUPARNT,.TIUL,TIUPDATA,1)
- End DoDot:2
- +45 IF TIUGPRNT
- Begin DoDot:2
- +46 SET @VALMAR@(TIUL,0)=" --- Original Interdisciplinary Entry ---"
- +47 SET TIUL=+$GET(TIUL)+1
- SET @VALMAR@(TIUL,0)=""
- +48 SET TIUL=+$GET(TIUL)+1
- +49 SET @VALMAR@(TIUL,0)=TIUPDATE_" "_TIUPNAME_":"
- +50 DO LOADREC(TIUPARNT,.TIUL,TIUGDATA)
- +51 SET TIUL=+$GET(TIUL)+1
- SET @VALMAR@(TIUL,0)=""
- +52 SET TIUL=+$GET(TIUL)+1
- +53 SET @VALMAR@(TIUL,0)=" --- Interdisciplinary Note ---"
- +54 DO LOADID^TIUGBR(TIUGPRNT,.TIUL,TIUPDATA,1)
- End DoDot:2
- End DoDot:1
- QUIT
- +55 ; ---- Load components of TIUDA: ----
- +56 SET TIUKID=0
- +57 FOR
- SET TIUKID=$ORDER(^TIU(8925,"DAD",+TIUDA,TIUKID))
- if +TIUKID'>0
- QUIT
- Begin DoDot:1
- +58 IF +$$ISADDNDM^TIULC1(TIUKID)'>0
- DO LOADREC(TIUKID,.TIUL,TIUGDATA)
- End DoDot:1
- +59 ; ---- Load signature of TIUDA if TIUDA is not addm
- +60 ; or comp: ----
- +61 IF '$$ISCOMP^TIUBR(TIUDA)
- DO LOADSIG(TIUDA,.TIUL)
- +62 ; ---- Load addenda of TIUDA: ----
- +63 SET TIUKID=0
- +64 FOR
- SET TIUKID=$ORDER(^TIU(8925,"DAD",+TIUDA,TIUKID))
- if +TIUKID'>0
- QUIT
- Begin DoDot:1
- +65 ; If an addendum has focus, don't show it again unless
- +66 ; loading whole ID note:
- +67 IF '$GET(TIUGWHOL)
- IF +TIUKID=+$GET(^TMP("TIU FOCUS",$JOB))
- QUIT
- +68 IF +$$ISADDNDM^TIULC1(TIUKID)
- DO LOADADD^TIUBR(TIUKID,.TIUL)
- End DoDot:1
- +69 ; ---- Load the rest of the ID note display: ----
- +70 IF $PIECE(TIUGDATA,U,2)!$PIECE(TIUGDATA,U,3)
- DO IDREST(TIUDA,.TIUL,TIUGDATA,.TIUGWHOL)
- +71 QUIT
- +72 ;
- IDREST(TIUDA,TIUL,TIUGDATA,TIUGWHOL) ; Load rest of ID note display
- +1 NEW IDDAD
- +2 SET IDDAD=+$PIECE(TIUGDATA,U,3)
- +3 ; ---- If Browsed Record is an ID child, & this cycle hasn't begun
- +4 ; loading the whole note, then load the whole ID Note after
- +5 ; the browsed child: ----
- +6 IF IDDAD
- IF '$GET(TIUGWHOL)
- Begin DoDot:1
- +7 SET TIUGWHOL=1
- +8 NEW TIULINE
- SET $PIECE(TIULINE,"=",79)=""
- +9 SET TIUL=+$GET(TIUL)+1
- SET @VALMAR@(TIUL,0)=""
- +10 SET TIUL=+$GET(TIUL)+1
- SET @VALMAR@(TIUL,0)=TIULINE
- +11 SET TIUL=+$GET(TIUL)+1
- SET @VALMAR@(TIUL,0)=""
- +12 SET TIUL=+$GET(TIUL)+1
- SET @VALMAR@(TIUL,0)=" --- Interdisciplinary Note ---"
- +13 DO LOADID^TIUGBR(IDDAD,.TIUL,TIUGDATA,TIUGWHOL)
- End DoDot:1
- QUIT
- +14 ; ---- If Browsed Record is an ID parent, & this cycle has
- +15 ; just loaded the parent entry, OR
- +16 ; If Browsed Record is an ID child, & this cycle has begun
- +17 ; loading the whole ID note, and is currently loading the first
- +18 ; entry of the whole note,
- +19 ; Then load kids: ----
- +20 IF $PIECE(TIUGDATA,U,2)&(TIUDA=+TIUGDATA)!(IDDAD&$GET(TIUGWHOL)&(TIUDA=IDDAD))
- Begin DoDot:1
- +21 DO LOADKIDS^TIUBR(TIUDA,.TIUL,TIUGDATA,$GET(TIUGWHOL))
- KILL TIUGWHOL
- +22 SET TIUL=+$GET(TIUL)+1
- SET @VALMAR@(TIUL,0)=""
- +23 SET TIUL=+$GET(TIUL)+1
- SET @VALMAR@(TIUL,0)=" << Interdisciplinary Note - End >>"
- End DoDot:1
- +24 QUIT
- EXSTNOTE(DFN,TIUDA) ; Sample/display existing notes
- +1 NEW TIU,TIUPRM0,TIUPRM1,TIUSEE,TIUOUT,TIUY,TIUQUIT
- +2 DO SETPARM^TIULE
- +3 if TIUDA'>0
- QUIT
- +4 DO GETTIU^TIULD(.TIU,+TIUDA)
- +5 IF $DATA(TIU)
- Begin DoDot:1
- +6 SET TIUSEE=$$CANDO^TIULP(TIUDA,"VIEW")
- +7 IF 'TIUSEE
- Begin DoDot:2
- +8 WRITE !!,$CHAR(7),$PIECE(TIUSEE,U,2),!
- +9 if $$READ^TIUU("FOA","Press RETURN to continue...")
- WRITE ""
- End DoDot:2
- QUIT
- +10 DO EN^VALM("TIU BROWSE FOR CLINICIAN")
- +11 KILL ^TMP("TIUVIEW",$JOB)
- +12 if $DATA(TIUQUIT)
- SET TIUOUT=1
- End DoDot:1
- +13 QUIT
- +14 ;
- LOADSIG(DA,TIUL) ; Get signature and co-signature blocks
- +1 NEW DIC,DIQ,DR,TIUSIG,TIUESIG1,TIUESIG2,TIUSIG1,TIUSIG2,TIUS1,TIUS2
- +2 NEW TIUSNM,TIUSTTL,TIUS1DT,TIUS2DT,TIUSDT
- +3 ;VMP/ELR CHANGED NEXT LINE FROM QUIT IF NOT DEFINED TO GO TO XTRA
- +4 IF '$DATA(^TIU(8925,DA,15))
- GOTO XTRA
- +5 SET DIC=8925
- SET DIQ="TIUSIG("
- SET DIQ(0)="IE"
- SET DR="1204;1208;1501:1505;1507:1513;1601:1605"
- +6 DO EN^DIQ1
- IF '$DATA(TIUSIG)
- QUIT
- +7 SET TIUS1=$SELECT(TIUSIG(8925,DA,1505,"I")="E":"/es/ ",TIUSIG(8925,DA,1505,"I")="C":"/s/ ",1:"")_$GET(TIUSIG(8925,DA,1503,"E"))
- +8 SET TIUS2=$SELECT(TIUSIG(8925,DA,1511,"I")="E":"/es/ ",TIUSIG(8925,DA,1511,"I")="C":"/s/ ",1:"")_$GET(TIUSIG(8925,DA,1509,"E"))
- +9 SET TIUESIG1=$GET(TIUSIG(8925,DA,1204,"I"))
- +10 SET TIUSIG1=$GET(TIUSIG(8925,DA,1502,"I"))
- +11 SET TIUS1DT=$SELECT(+$GET(TIUSIG(8925,DA,1501,"I")):"Signed: "_$$DATE^TIULS($GET(TIUSIG(8925,DA,1501,"I")),"MM/DD/CCYY HR:MIN"),1:"")
- +12 SET TIUESIG2=$GET(TIUSIG(8925,DA,1208,"I"))
- +13 SET TIUS2DT=$SELECT(+$GET(TIUSIG(8925,DA,1507,"I")):"Cosigned: "_$$DATE^TIULS($GET(TIUSIG(8925,DA,1507,"I")),"MM/DD/CCYY HR:MIN"),1:"")
- +14 SET TIUSIG2=$GET(TIUSIG(8925,DA,1508,"I"))
- +15 SET TIUL=+$GET(TIUL)+1
- SET @VALMAR@(TIUL,0)=" "
- +16 SET TIUL=+$GET(TIUL)+1
- SET @VALMAR@(TIUL,0)=TIUS1
- +17 SET TIUL=+$GET(TIUL)+1
- SET @VALMAR@(TIUL,0)=$GET(TIUSIG(8925,DA,1504,"E"))
- +18 SET TIUL=+$GET(TIUL)+1
- SET @VALMAR@(TIUL,0)=TIUS1DT
- +19 IF $GET(TIUSIG(8925,DA,1505,"I"))="C"
- Begin DoDot:1
- +20 NEW TIUONCH
- +21 SET TIUONCH=$GET(TIUSIG(8925,DA,1512,"E"))
- IF '$LENGTH(TIUONCH)
- SET TIUONCH=$GET(TIUSIG(8925,DA,1513,"E"))
- +22 SET TIUL=+$GET(TIUL)+1
- SET @VALMAR@(TIUL,0)="Marked signed on chart by: "_TIUONCH
- End DoDot:1
- +23 IF TIUSIG1]""
- IF (TIUSIG1'=TIUESIG1)
- DO LOADFOR(TIUSIG1,TIUESIG1,.TIUL)
- +24 IF +$GET(TIUSIG(8925,DA,1507,"I"))>0
- Begin DoDot:1
- +25 SET TIUL=+$GET(TIUL)+1
- SET @VALMAR@(TIUL,0)=" "
- +26 SET TIUL=+$GET(TIUL)+1
- SET @VALMAR@(TIUL,0)=TIUS2
- +27 SET TIUL=+$GET(TIUL)+1
- SET @VALMAR@(TIUL,0)=$GET(TIUSIG(8925,DA,1510,"E"))
- +28 SET TIUL=+$GET(TIUL)+1
- SET @VALMAR@(TIUL,0)=TIUS2DT
- +29 IF $GET(TIUSIG(8925,DA,1511,"I"))="C"
- Begin DoDot:2
- +30 SET TIUL=+$GET(TIUL)+1
- SET @VALMAR@(TIUL,0)="Marked cosigned on chart by: "_$GET(TIUSIG(8925,DA,1513,"E"))
- End DoDot:2
- End DoDot:1
- +31 IF TIUSIG2]""
- IF (TIUSIG2'=TIUESIG2)
- DO LOADFOR(TIUSIG2,TIUESIG2,.TIUL)
- XTRA IF +$ORDER(^TIU(8925.7,"B",DA,0))
- DO XTRASIG(DA,.TIUL)
- +1 IF +$GET(TIUSIG(8925,DA,1601,"I"))
- Begin DoDot:1
- +2 NEW TIUMODE
- +3 SET TIUL=+$GET(TIUL)+1
- SET @VALMAR@(TIUL,0)=""
- +4 SET TIUL=+$GET(TIUL)+1
- +5 SET @VALMAR@(TIUL,0)=$$DATE^TIULS(TIUSIG(8925,DA,1601,"I"),"MM/DD/CCYY HR:MIN")_" AMENDMENT FILED:"
- +6 SET TIUL=+$GET(TIUL)+1
- SET @VALMAR@(TIUL,0)=""
- SET TIUL=+$GET(TIUL)+1
- +7 SET TIUMODE=$SELECT(+$GET(TIUSIG(8925,DA,1603,"I")):"/es/ ",1:" /s/ ")
- +8 SET @VALMAR@(TIUL,0)=TIUMODE_$SELECT($GET(TIUSIG(8925,DA,1604,"E"))]"":$GET(TIUSIG(8925,DA,1604,"E")),1:$GET(TIUSIG(8925,DA,1602,"E")))
- +9 IF $LENGTH($GET(TIUSIG(8925,DA,1605,"E")))
- Begin DoDot:2
- +10 SET TIUL=+$GET(TIUL)+1
- SET @VALMAR@(TIUL,0)=$GET(TIUSIG(8925,DA,1605,"E"))
- End DoDot:2
- +11 SET TIUL=+$GET(TIUL)+1
- SET @VALMAR@(TIUL,0)=$PIECE($GET(TIUPRM1),U,5)
- End DoDot:1
- +12 QUIT
- XTRASIG(TIUDA,TIUL) ; Load additional signature blocks
- +1 NEW TIUI,DA,DR,DIC,DIQ,TIUXTRA
- SET TIUI=0
- +2 SET DIC="^TIU(8925.7,"
- SET DIQ="TIUXTRA"
- +3 SET TIUL=+$GET(TIUL)+1
- SET @VALMAR@(TIUL,0)=" "
- +4 SET TIUL=+$GET(TIUL)+1
- SET @VALMAR@(TIUL,0)="Receipt Acknowledged By:"
- +5 FOR
- SET TIUI=$ORDER(^TIU(8925.7,"B",TIUDA,TIUI))
- if +TIUI'>0
- QUIT
- Begin DoDot:1
- +6 NEW TIUX,TIUSGNR,TIUSDT
- +7 SET DA=TIUI
- SET DR=".03:.08"
- SET DIQ(0)="IE"
- DO EN^DIQ1
- if +$DATA(TIUXTRA)'>9
- QUIT
- +8 SET TIUSGNR=$SELECT($LENGTH($GET(TIUXTRA(8925.7,DA,.06,"E"))):"/es/ "_$GET(TIUXTRA(8925.7,DA,.06,"E")),1:" "_$GET(TIUXTRA(8925.7,DA,.03,"E")))
- +9 SET TIUSDT=$SELECT(+$GET(TIUXTRA(8925.7,DA,.04,"I")):$$DATE^TIULS(TIUXTRA(8925.7,DA,.04,"I"),"MM/DD/CCYY HR:MIN"),1:"* AWAITING SIGNATURE *")
- +10 SET TIUX=$$SETSTR^VALM1(TIUSDT,$GET(TIUX),1,38)
- +11 SET TIUX=$$SETSTR^VALM1(TIUSGNR,$GET(TIUX),25,55)
- +12 SET TIUL=+$GET(TIUL)+1
- SET @VALMAR@(TIUL,0)=TIUX
- SET TIUX=""
- +13 SET TIUX=$$SETSTR^VALM1($GET(TIUXTRA(8925.7,DA,.07,"E")),$GET(TIUX),30,50)
- +14 SET TIUL=+$GET(TIUL)+1
- SET @VALMAR@(TIUL,0)=TIUX
- +15 IF $GET(TIUXTRA(8925.7,DA,.05,"I"))
- IF $GET(TIUXTRA(8925.7,DA,.05,"I"))'=$GET(TIUXTRA(8925.7,DA,.03,"I"))
- Begin DoDot:2
- +16 NEW TIUFOR
- +17 SET TIUX=""
- +18 SET TIUFOR="for "_$PIECE($GET(TIUXTRA(8925.7,DA,.03,"E")),",",2)_" "_$PIECE($GET(TIUXTRA(8925.7,DA,.03,"E")),",")
- +19 SET TIUX=$$SETSTR^VALM1(TIUFOR,$GET(TIUX),26,55)
- +20 SET TIUL=TIUL+1
- SET @VALMAR@(TIUL,0)=TIUX
- End DoDot:2
- End DoDot:1
- +21 QUIT
- LOADFOR(TIUS1,TIUES1,TIUL) ; Apply "for" block
- +1 NEW TIUESN1,TIUEST1,TIUFORN,TIUFORT
- +2 SET TIUESN1="for "_$$SIGNAME^TIULS(TIUES1)
- SET TIUEST1=$$SIGTITL^TIULS(TIUES1)
- +3 IF +$GET(TIUS1)
- IF ($GET(TIUS1)'=$GET(TIUES1))
- SET TIUFORN=$$SETSTR^VALM1(TIUESN1,$GET(TIUFORN),1,50)
- SET TIUFORT=$$SETSTR^VALM1(TIUEST1,$GET(TIUFORT),1,50)
- +4 SET TIUL=+$GET(TIUL)+1
- SET @VALMAR@(TIUL,0)=TIUFORN
- +5 SET TIUL=+$GET(TIUL)+1
- SET @VALMAR@(TIUL,0)=TIUFORT
- +6 QUIT