- TIUBR ; SLC/JER - Browse Action Subroutines ;8/16/06 09:08
- ;;1.0;TEXT INTEGRATION UTILITIES;**32,87,93,58,100,162,112,173,208,211**;Jun 20, 1997;Build 26
- ; Move LOADSIG, XTRASIG, LOADFOR, LOADREC to TIUBR1.
- EN ; Entry code for LM templates TIU BROWSE
- N TIUY
- ;Kill TIUGDATA in CLEAN; don't new it here
- ; -- Set TIUGDATA, which describes the note originally
- ; selected to be browsed. --
- ; TIUGDATA = 0 or
- ; = TIUDA^HASIDKID^TIUD21^PRMSORT, where
- ; PRMSORT = "TITLE" or "REFDT". See 8925.95, fld .18
- S TIUGDATA=$$IDDATA^TIURECL1(TIUDA)
- D BLDTMP(TIUDA)
- Q
- HDR ; Build Header
- N TIUDTYP,DFN
- I '$D(TIUPRM0)!'$D(TIUPRM1) D SETPARM^TIULE
- D:$D(TIU)'>9 GETTIU^TIULD(.TIU,+TIUDA)
- S VALMHDR(1)=$$CENTER^TIULS($P($G(TIU("DOCTYP")),U,2))
- ; Docmt header line Patname, SSN, [Location, Visit]:
- S VALMHDR(2)=$$SETREC(TIUGDATA)
- Q
- BLDTMP(TIUDA) ; Build ^TMP("TIUVIEW",$J,
- ; Requires TIUDA = IFN of note selected to be browsed.
- ; Needs TIUGDATA, set in EN
- N TIUI,TIUL,TIUREC,TIUDADD,ONBROWSE S (TIUDADD,TIUI)=0
- N TIUNAME K ^TMP("TIUVIEW",$J),^TMP("TIU FOCUS",$J)
- I '$D(^TIU(8925,+TIUDA,0)) S VALMQUIT=1 Q
- S ^TMP("TIU FOCUS",$J)=TIUDA
- D INQUIRE^TIUGBR(TIUDA,.TIUREC)
- I $D(TIUREC)>9 W !!,"Opening "_TIUREC(8925,+TIUDA,.01)_" record for review..."
- ; --- if the document has a browse action, execute it ---
- S ONBROWSE=$$ONBROWSE^TIULC1(+$G(^TIU(8925,+TIUDA,0)))
- I $L(ONBROWSE) D LOADSUPP(ONBROWSE,TIUDA,.TIUL)
- ; ---- Load dictation, transcription data, etc.: ----
- D LOADTOP(.TIUREC,TIUDA,.TIUL,TIUGDATA)
- ; ---- Load the remainder of the record: ----
- D LOADREC^TIUBR1(TIUDA,.TIUL,TIUGDATA)
- K ^TMP("TIU FOCUS",$J)
- S ^TMP("TIUVIEW",$J,0)=$G(^TIU(8925,+TIUDA,"TEXT",0))
- S $P(^TMP("TIUVIEW",$J,0),U,3,4)=$G(TIUL)_U_$G(TIUL),VALMCNT=+$G(TIUL)
- Q
- LOADSUPP(METHOD,TIUDA,TIUL) ; Execute OnBrowse/Load Supplementary data
- N TIUY,TIUI S TIUI=0
- X METHOD I '$D(@TIUY) Q
- F S TIUI=$O(@TIUY@(TIUI)) Q:+TIUI'>0 D
- . S TIUL=+$G(TIUL)+1,@VALMAR@(TIUL,0)=$G(@TIUY@(TIUI))
- S TIUL=+$G(TIUL)+1,@VALMAR@(TIUL,0)=" "
- K @TIUY
- Q
- LOADTOP(TIUREC,TIUDA,TIUL,TIUGDATA) ; Load dictation, transcription data, etc.
- ; Requires array TIUREC, TIUDA, array TIUL, TIUGDATA
- N TIUY,SHORT,CURCHLD,CURPRNT,SELCHLD,SELPRNT
- ; ---- For ID note, include Title, [Location, & Visit] with each
- ; entry, since they vary by entry.
- ; ---- Follow with Date, Author, etc.
- ; ---- For ID children in whole note display, shorten top info:
- ; Instead of Title, Location, Visit, Date, Author, etc.,
- ; use just Title, followed by just Date and Status:
- S (SHORT,CURCHLD,CURPRNT,SELCHLD,SELPRNT)=0
- I $P(TIUGDATA,U,3) S SELCHLD=1 ; Selected record was IDchild
- I $P(TIUGDATA,U,2) S SELPRNT=1
- I SELCHLD,TIUDA'=$P(TIUGDATA,U,3) S CURCHLD=1 ; Current rec is IDchild
- I SELCHLD,TIUDA=$P(TIUGDATA,U,3) S CURPRNT=1
- I SELPRNT,TIUDA=+TIUGDATA S CURPRNT=1
- I SELPRNT,TIUDA'=+TIUGDATA S CURCHLD=1
- I SELPRNT,CURCHLD S SHORT=1 ;Child in whole note: shorten top info
- I SELCHLD,CURCHLD,$G(TIUGWHOL) S SHORT=1
- I SELCHLD!SELPRNT D
- . D IDTOP^TIUGBR(TIUDA,.TIUL,SHORT,CURPRNT)
- S TIUL=+$G(TIUL)+1,TIUY=""
- I $L(TIUREC(8925,+TIUDA,89261)) D
- . S TIUY=$$SETSTR^VALM1("STANDARD TITLE: "_TIUREC(8925,+TIUDA,89261),TIUY,1,64)
- . S @VALMAR@(TIUL,0)=TIUY
- . S TIUL=TIUL+1,TIUY=""
- I SHORT D
- . S TIUY=$$SETSTR^VALM1("DATE OF NOTE: "_TIUREC(8925,+TIUDA,1301),$G(TIUY),1,39)
- . S TIUY=$$SETSTR^VALM1("STATUS: "_TIUREC(8925,+TIUDA,.05),$G(TIUY),42,38)
- . S @VALMAR@(TIUL,0)=TIUY
- I 'SHORT D
- . I $L(TIUREC(8925,+TIUDA,1307)) D I 1
- . . S TIUY=$$SETSTR^VALM1("DICT DATE: "_TIUREC(8925,+TIUDA,1307),$G(TIUY),4,39)
- . E S TIUY=$$SETSTR^VALM1("DATE OF NOTE: "_TIUREC(8925,+TIUDA,1301),$G(TIUY),1,39)
- . S TIUY=$$SETSTR^VALM1("ENTRY DATE: "_TIUREC(8925,+TIUDA,1201),$G(TIUY),38,39)
- . S @VALMAR@(TIUL,0)=TIUY
- . S TIUL=TIUL+1,TIUY=""
- . I $L(TIUREC(8925,+TIUDA,1307)) D I 1
- . . I +$G(^TIU(8925,+TIUDA,0))=$$CHKFILE^TIUADCL(8925.1,"OPERATION REPORT","I $P(^(0),U,4)=""DOC""") S TIUY=$$SETSTR^VALM1("SURGEON: "_TIUREC(8925,+TIUDA,1202),$G(TIUY),6,32) Q
- . . S TIUY=$$SETSTR^VALM1("DICTATED BY: "_TIUREC(8925,+TIUDA,1202),$G(TIUY),2,32)
- . E D
- . . S TIUY=$$SETSTR^VALM1("AUTHOR: "_TIUREC(8925,+TIUDA,1202),$G(TIUY),7,27)
- . . I +$G(^TIU(8925,+TIUDA,0))=$$CHKFILE^TIUADCL(8925.1,"OPERATION REPORT","I $P(^(0),U,4)=""DOC""") S TIUY=$$SETSTR^VALM1("SURGEON: "_TIUREC(8925,+TIUDA,1202),$G(TIUY),6,32)
- . I $L(TIUREC(8925,+TIUDA,1209)) D I 1
- . . S TIUY=$$SETSTR^VALM1("ATTENDING: "_TIUREC(8925,+TIUDA,1209),$G(TIUY),39,40)
- . E S TIUY=$$SETSTR^VALM1("EXP COSIGNER: "_TIUREC(8925,+TIUDA,1208),$G(TIUY),36,40)
- . S @VALMAR@(TIUL,0)=TIUY
- . S TIUL=TIUL+1,TIUY=""
- . S TIUY=$$SETSTR^VALM1("URGENCY: "_TIUREC(8925,+TIUDA,.09),$G(TIUY),6,36)
- . S TIUY=$$SETSTR^VALM1("STATUS: "_TIUREC(8925,+TIUDA,.05),$G(TIUY),42,38)
- . S @VALMAR@(TIUL,0)=TIUY
- S TIUL=TIUL+1,TIUY=""
- I '$L($G(^TIU(8925,+TIUDA,17))) S @VALMAR@(TIUL,0)=TIUY
- E D
- . S TIUY=$$SETSTR^VALM1("SUBJECT: "_$G(^TIU(8925,+TIUDA,17)),$G(TIUY),6,74)
- . S @VALMAR@(TIUL,0)=TIUY
- . S TIUL=TIUL+1,TIUY="",@VALMAR@(TIUL,0)=TIUY
- I +$$HASADDEN^TIULC1(TIUDA) D
- . S TIUY=" *** "_$$PNAME^TIULC1(+$G(^TIU(8925,TIUDA,0)))_" Has ADDENDA ***"
- . S TIUL=+$G(TIUL)+1,@VALMAR@(TIUL,0)=TIUY
- . S TIUL=+$G(TIUL)+1,@VALMAR@(TIUL,0)=""
- Q
- ;
- LOADKIDS(TIUDA,TIUL,TIUGDATA,TIUGWHOL) ; Load ID kids of TIUDA
- ; Requires TIUDA, array TIUL, TIUGDATA
- N TIUK,PRMSORT,KIDDA,TIUD0,TIUD21
- I $G(^TMP("TIUR",$J,"IDDATA",TIUDA)) S PRMSORT=$P(^TMP("TIUR",$J,"IDDATA",TIUDA),U,4)
- E S TIUD0=$G(^TIU(8925,TIUDA,0)),TIUD21=$G(^TIU(8925,TIUDA,21)),PRMSORT=$P($$IDDATA^TIURECL1(TIUDA,TIUD0,TIUD21),U,4)
- D GETIDKID^TIURECL2(TIUDA,PRMSORT) ; sets array ^TMP("TIUIDKID",$J,
- S TIUK=0
- F S TIUK=$O(^TMP("TIUIDKID",$J,TIUDA,TIUK)) Q:+TIUK'>0 D
- . S KIDDA=^TMP("TIUIDKID",$J,TIUDA,TIUK)
- . D LOADID^TIUGBR(KIDDA,.TIUL,TIUGDATA,$G(TIUGWHOL))
- K ^TMP("TIUIDKID",$J)
- Q
- ;
- ISCOMP(DA) ; Evaluate whether a given record is a component
- N TIUY,TIUTYP
- S TIUTYP=+$G(^TIU(8925,DA,0))
- S TIUY=$S($P($G(^TIU(8925.1,+TIUTYP,0)),U,4)="CO":1,1:0)
- Q TIUY
- LOADADD(TIUDADD,TIUL) ; Load addenda
- N TIUDADT,TIUJ,CANSEE
- S CANSEE=$$CANDO^TIULP(+TIUDADD,"VIEW")
- S TIUJ=0,TIUL=+$G(TIUL)+1,@VALMAR@(TIUL,0)=" "
- S TIUDADT=$$DATE^TIULS($P($G(^TIU(8925,+TIUDADD,13)),U),"MM/DD/CCYY")
- S TIUL=TIUL+1,@VALMAR@(TIUL,0)=TIUDADT_" ADDENDUM"_" STATUS: "_$$STATUS^TIULF(TIUDADD) ;P162
- I +CANSEE'>0 D Q
- . S TIUL=+$G(TIUL)+1
- . S @VALMAR@(TIUL,0)=$P(CANSEE,U,2)
- F S TIUJ=$O(^TIU(8925,+TIUDADD,"TEXT",TIUJ)) Q:+TIUJ'>0 D
- . S TIUL=+$G(TIUL)+1
- . S @VALMAR@(TIUL,0)=$G(^TIU(8925,+TIUDADD,"TEXT",TIUJ,0))
- D LOADSIG^TIUBR1(TIUDADD,.TIUL)
- Q
- ;
- SETREC(TIUGDATA) ; Sets docmt header line Patname, SSN, [Location, Visit]
- ; Requires TIUGDATA
- N Y
- S Y=$$SETSTR^VALM1($$NAME^TIULS($G(TIU("PNM")),"LAST,FI MI"),$G(Y),1,15)
- S Y=$$SETSTR^VALM1($G(TIU("SSN")),$G(Y),16,12)
- ; ---- If TIUDA is an ID entry, write ID, ADDENDED? in header
- ; and leave out entry-specific info (Location, Visit)
- ; since that goes with each individual entry: ----
- I $P(TIUGDATA,U,2)!$P(TIUGDATA,U,3) D G SETRX
- . S Y=$$SETSTR^VALM1("Interdisciplinary "_$S($P(TIUGDATA,U,2):"Note",1:"Entry"),$G(Y),29,23)
- . I $P(TIUGDATA,U,2) S Y=$$SETSTR^VALM1("ADDENDED?"_$S($$HASADDEN^TIULC1(+TIUDA,1):" Yes",1:" No"),$G(Y),66,13)
- S Y=$$SETSTR^VALM1($P($G(TIU("LOC")),U,2),$G(Y),30,17)
- I $L($G(TIU("WARD"))) D
- . S Y=$$SETSTR^VALM1("Adm: "_$$DATE^TIULS(+TIU("EDT"),"MM/DD/CCYY"),$G(Y),48,15)
- . S Y=$$SETSTR^VALM1("Dis: "_$$DATE^TIULS(+TIU("LDT"),"MM/DD/CCYY"),$G(Y),65,15)
- I '$L($G(TIU("WARD"))) D
- . S Y=$$SETSTR^VALM1("Visit Date: "_$$DATE^TIULS(+$G(TIU("EDT")),"MM/DD/CCYY HR:MIN"),$G(Y),51,28)
- SETRX Q Y
- ;
- CLEAN ; Die, filthy spawn!!!
- D CLEAN^VALM10 K VALMHDR,TIU,TIUPRM0,TIUPRM1,TIUGDATA
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUBR 7926 printed Jan 18, 2025@03:40:09 Page 2
- TIUBR ; SLC/JER - Browse Action Subroutines ;8/16/06 09:08
- +1 ;;1.0;TEXT INTEGRATION UTILITIES;**32,87,93,58,100,162,112,173,208,211**;Jun 20, 1997;Build 26
- +2 ; Move LOADSIG, XTRASIG, LOADFOR, LOADREC to TIUBR1.
- EN ; Entry code for LM templates TIU BROWSE
- +1 NEW TIUY
- +2 ;Kill TIUGDATA in CLEAN; don't new it here
- +3 ; -- Set TIUGDATA, which describes the note originally
- +4 ; selected to be browsed. --
- +5 ; TIUGDATA = 0 or
- +6 ; = TIUDA^HASIDKID^TIUD21^PRMSORT, where
- +7 ; PRMSORT = "TITLE" or "REFDT". See 8925.95, fld .18
- +8 SET TIUGDATA=$$IDDATA^TIURECL1(TIUDA)
- +9 DO BLDTMP(TIUDA)
- +10 QUIT
- HDR ; Build Header
- +1 NEW TIUDTYP,DFN
- +2 IF '$DATA(TIUPRM0)!'$DATA(TIUPRM1)
- DO SETPARM^TIULE
- +3 if $DATA(TIU)'>9
- DO GETTIU^TIULD(.TIU,+TIUDA)
- +4 SET VALMHDR(1)=$$CENTER^TIULS($PIECE($GET(TIU("DOCTYP")),U,2))
- +5 ; Docmt header line Patname, SSN, [Location, Visit]:
- +6 SET VALMHDR(2)=$$SETREC(TIUGDATA)
- +7 QUIT
- BLDTMP(TIUDA) ; Build ^TMP("TIUVIEW",$J,
- +1 ; Requires TIUDA = IFN of note selected to be browsed.
- +2 ; Needs TIUGDATA, set in EN
- +3 NEW TIUI,TIUL,TIUREC,TIUDADD,ONBROWSE
- SET (TIUDADD,TIUI)=0
- +4 NEW TIUNAME
- KILL ^TMP("TIUVIEW",$JOB),^TMP("TIU FOCUS",$JOB)
- +5 IF '$DATA(^TIU(8925,+TIUDA,0))
- SET VALMQUIT=1
- QUIT
- +6 SET ^TMP("TIU FOCUS",$JOB)=TIUDA
- +7 DO INQUIRE^TIUGBR(TIUDA,.TIUREC)
- +8 IF $DATA(TIUREC)>9
- WRITE !!,"Opening "_TIUREC(8925,+TIUDA,.01)_" record for review..."
- +9 ; --- if the document has a browse action, execute it ---
- +10 SET ONBROWSE=$$ONBROWSE^TIULC1(+$GET(^TIU(8925,+TIUDA,0)))
- +11 IF $LENGTH(ONBROWSE)
- DO LOADSUPP(ONBROWSE,TIUDA,.TIUL)
- +12 ; ---- Load dictation, transcription data, etc.: ----
- +13 DO LOADTOP(.TIUREC,TIUDA,.TIUL,TIUGDATA)
- +14 ; ---- Load the remainder of the record: ----
- +15 DO LOADREC^TIUBR1(TIUDA,.TIUL,TIUGDATA)
- +16 KILL ^TMP("TIU FOCUS",$JOB)
- +17 SET ^TMP("TIUVIEW",$JOB,0)=$GET(^TIU(8925,+TIUDA,"TEXT",0))
- +18 SET $PIECE(^TMP("TIUVIEW",$JOB,0),U,3,4)=$GET(TIUL)_U_$GET(TIUL)
- SET VALMCNT=+$GET(TIUL)
- +19 QUIT
- LOADSUPP(METHOD,TIUDA,TIUL) ; Execute OnBrowse/Load Supplementary data
- +1 NEW TIUY,TIUI
- SET TIUI=0
- +2 XECUTE METHOD
- IF '$DATA(@TIUY)
- QUIT
- +3 FOR
- SET TIUI=$ORDER(@TIUY@(TIUI))
- if +TIUI'>0
- QUIT
- Begin DoDot:1
- +4 SET TIUL=+$GET(TIUL)+1
- SET @VALMAR@(TIUL,0)=$GET(@TIUY@(TIUI))
- End DoDot:1
- +5 SET TIUL=+$GET(TIUL)+1
- SET @VALMAR@(TIUL,0)=" "
- +6 KILL @TIUY
- +7 QUIT
- LOADTOP(TIUREC,TIUDA,TIUL,TIUGDATA) ; Load dictation, transcription data, etc.
- +1 ; Requires array TIUREC, TIUDA, array TIUL, TIUGDATA
- +2 NEW TIUY,SHORT,CURCHLD,CURPRNT,SELCHLD,SELPRNT
- +3 ; ---- For ID note, include Title, [Location, & Visit] with each
- +4 ; entry, since they vary by entry.
- +5 ; ---- Follow with Date, Author, etc.
- +6 ; ---- For ID children in whole note display, shorten top info:
- +7 ; Instead of Title, Location, Visit, Date, Author, etc.,
- +8 ; use just Title, followed by just Date and Status:
- +9 SET (SHORT,CURCHLD,CURPRNT,SELCHLD,SELPRNT)=0
- +10 ; Selected record was IDchild
- IF $PIECE(TIUGDATA,U,3)
- SET SELCHLD=1
- +11 IF $PIECE(TIUGDATA,U,2)
- SET SELPRNT=1
- +12 ; Current rec is IDchild
- IF SELCHLD
- IF TIUDA'=$PIECE(TIUGDATA,U,3)
- SET CURCHLD=1
- +13 IF SELCHLD
- IF TIUDA=$PIECE(TIUGDATA,U,3)
- SET CURPRNT=1
- +14 IF SELPRNT
- IF TIUDA=+TIUGDATA
- SET CURPRNT=1
- +15 IF SELPRNT
- IF TIUDA'=+TIUGDATA
- SET CURCHLD=1
- +16 ;Child in whole note: shorten top info
- IF SELPRNT
- IF CURCHLD
- SET SHORT=1
- +17 IF SELCHLD
- IF CURCHLD
- IF $GET(TIUGWHOL)
- SET SHORT=1
- +18 IF SELCHLD!SELPRNT
- Begin DoDot:1
- +19 DO IDTOP^TIUGBR(TIUDA,.TIUL,SHORT,CURPRNT)
- End DoDot:1
- +20 SET TIUL=+$GET(TIUL)+1
- SET TIUY=""
- +21 IF $LENGTH(TIUREC(8925,+TIUDA,89261))
- Begin DoDot:1
- +22 SET TIUY=$$SETSTR^VALM1("STANDARD TITLE: "_TIUREC(8925,+TIUDA,89261),TIUY,1,64)
- +23 SET @VALMAR@(TIUL,0)=TIUY
- +24 SET TIUL=TIUL+1
- SET TIUY=""
- End DoDot:1
- +25 IF SHORT
- Begin DoDot:1
- +26 SET TIUY=$$SETSTR^VALM1("DATE OF NOTE: "_TIUREC(8925,+TIUDA,1301),$GET(TIUY),1,39)
- +27 SET TIUY=$$SETSTR^VALM1("STATUS: "_TIUREC(8925,+TIUDA,.05),$GET(TIUY),42,38)
- +28 SET @VALMAR@(TIUL,0)=TIUY
- End DoDot:1
- +29 IF 'SHORT
- Begin DoDot:1
- +30 IF $LENGTH(TIUREC(8925,+TIUDA,1307))
- Begin DoDot:2
- +31 SET TIUY=$$SETSTR^VALM1("DICT DATE: "_TIUREC(8925,+TIUDA,1307),$GET(TIUY),4,39)
- End DoDot:2
- IF 1
- +32 IF '$TEST
- SET TIUY=$$SETSTR^VALM1("DATE OF NOTE: "_TIUREC(8925,+TIUDA,1301),$GET(TIUY),1,39)
- +33 SET TIUY=$$SETSTR^VALM1("ENTRY DATE: "_TIUREC(8925,+TIUDA,1201),$GET(TIUY),38,39)
- +34 SET @VALMAR@(TIUL,0)=TIUY
- +35 SET TIUL=TIUL+1
- SET TIUY=""
- +36 IF $LENGTH(TIUREC(8925,+TIUDA,1307))
- Begin DoDot:2
- +37 IF +$GET(^TIU(8925,+TIUDA,0))=$$CHKFILE^TIUADCL(8925.1,"OPERATION REPORT","I $P(^(0),U,4)=""DOC""")
- SET TIUY=$$SETSTR^VALM1("SURGEON: "_TIUREC(8925,+TIUDA,1202),$GET(TIUY),6,32)
- QUIT
- +38 SET TIUY=$$SETSTR^VALM1("DICTATED BY: "_TIUREC(8925,+TIUDA,1202),$GET(TIUY),2,32)
- End DoDot:2
- IF 1
- +39 IF '$TEST
- Begin DoDot:2
- +40 SET TIUY=$$SETSTR^VALM1("AUTHOR: "_TIUREC(8925,+TIUDA,1202),$GET(TIUY),7,27)
- +41 IF +$GET(^TIU(8925,+TIUDA,0))=$$CHKFILE^TIUADCL(8925.1,"OPERATION REPORT","I $P(^(0),U,4)=""DOC""")
- SET TIUY=$$SETSTR^VALM1("SURGEON: "_TIUREC(8925,+TIUDA,1202),$GET(TIUY),6,32)
- End DoDot:2
- +42 IF $LENGTH(TIUREC(8925,+TIUDA,1209))
- Begin DoDot:2
- +43 SET TIUY=$$SETSTR^VALM1("ATTENDING: "_TIUREC(8925,+TIUDA,1209),$GET(TIUY),39,40)
- End DoDot:2
- IF 1
- +44 IF '$TEST
- SET TIUY=$$SETSTR^VALM1("EXP COSIGNER: "_TIUREC(8925,+TIUDA,1208),$GET(TIUY),36,40)
- +45 SET @VALMAR@(TIUL,0)=TIUY
- +46 SET TIUL=TIUL+1
- SET TIUY=""
- +47 SET TIUY=$$SETSTR^VALM1("URGENCY: "_TIUREC(8925,+TIUDA,.09),$GET(TIUY),6,36)
- +48 SET TIUY=$$SETSTR^VALM1("STATUS: "_TIUREC(8925,+TIUDA,.05),$GET(TIUY),42,38)
- +49 SET @VALMAR@(TIUL,0)=TIUY
- End DoDot:1
- +50 SET TIUL=TIUL+1
- SET TIUY=""
- +51 IF '$LENGTH($GET(^TIU(8925,+TIUDA,17)))
- SET @VALMAR@(TIUL,0)=TIUY
- +52 IF '$TEST
- Begin DoDot:1
- +53 SET TIUY=$$SETSTR^VALM1("SUBJECT: "_$GET(^TIU(8925,+TIUDA,17)),$GET(TIUY),6,74)
- +54 SET @VALMAR@(TIUL,0)=TIUY
- +55 SET TIUL=TIUL+1
- SET TIUY=""
- SET @VALMAR@(TIUL,0)=TIUY
- End DoDot:1
- +56 IF +$$HASADDEN^TIULC1(TIUDA)
- Begin DoDot:1
- +57 SET TIUY=" *** "_$$PNAME^TIULC1(+$GET(^TIU(8925,TIUDA,0)))_" Has ADDENDA ***"
- +58 SET TIUL=+$GET(TIUL)+1
- SET @VALMAR@(TIUL,0)=TIUY
- +59 SET TIUL=+$GET(TIUL)+1
- SET @VALMAR@(TIUL,0)=""
- End DoDot:1
- +60 QUIT
- +61 ;
- LOADKIDS(TIUDA,TIUL,TIUGDATA,TIUGWHOL) ; Load ID kids of TIUDA
- +1 ; Requires TIUDA, array TIUL, TIUGDATA
- +2 NEW TIUK,PRMSORT,KIDDA,TIUD0,TIUD21
- +3 IF $GET(^TMP("TIUR",$JOB,"IDDATA",TIUDA))
- SET PRMSORT=$PIECE(^TMP("TIUR",$JOB,"IDDATA",TIUDA),U,4)
- +4 IF '$TEST
- SET TIUD0=$GET(^TIU(8925,TIUDA,0))
- SET TIUD21=$GET(^TIU(8925,TIUDA,21))
- SET PRMSORT=$PIECE($$IDDATA^TIURECL1(TIUDA,TIUD0,TIUD21),U,4)
- +5 ; sets array ^TMP("TIUIDKID",$J,
- DO GETIDKID^TIURECL2(TIUDA,PRMSORT)
- +6 SET TIUK=0
- +7 FOR
- SET TIUK=$ORDER(^TMP("TIUIDKID",$JOB,TIUDA,TIUK))
- if +TIUK'>0
- QUIT
- Begin DoDot:1
- +8 SET KIDDA=^TMP("TIUIDKID",$JOB,TIUDA,TIUK)
- +9 DO LOADID^TIUGBR(KIDDA,.TIUL,TIUGDATA,$GET(TIUGWHOL))
- End DoDot:1
- +10 KILL ^TMP("TIUIDKID",$JOB)
- +11 QUIT
- +12 ;
- ISCOMP(DA) ; Evaluate whether a given record is a component
- +1 NEW TIUY,TIUTYP
- +2 SET TIUTYP=+$GET(^TIU(8925,DA,0))
- +3 SET TIUY=$SELECT($PIECE($GET(^TIU(8925.1,+TIUTYP,0)),U,4)="CO":1,1:0)
- +4 QUIT TIUY
- LOADADD(TIUDADD,TIUL) ; Load addenda
- +1 NEW TIUDADT,TIUJ,CANSEE
- +2 SET CANSEE=$$CANDO^TIULP(+TIUDADD,"VIEW")
- +3 SET TIUJ=0
- SET TIUL=+$GET(TIUL)+1
- SET @VALMAR@(TIUL,0)=" "
- +4 SET TIUDADT=$$DATE^TIULS($PIECE($GET(^TIU(8925,+TIUDADD,13)),U),"MM/DD/CCYY")
- +5 ;P162
- SET TIUL=TIUL+1
- SET @VALMAR@(TIUL,0)=TIUDADT_" ADDENDUM"_" STATUS: "_$$STATUS^TIULF(TIUDADD)
- +6 IF +CANSEE'>0
- Begin DoDot:1
- +7 SET TIUL=+$GET(TIUL)+1
- +8 SET @VALMAR@(TIUL,0)=$PIECE(CANSEE,U,2)
- End DoDot:1
- QUIT
- +9 FOR
- SET TIUJ=$ORDER(^TIU(8925,+TIUDADD,"TEXT",TIUJ))
- if +TIUJ'>0
- QUIT
- Begin DoDot:1
- +10 SET TIUL=+$GET(TIUL)+1
- +11 SET @VALMAR@(TIUL,0)=$GET(^TIU(8925,+TIUDADD,"TEXT",TIUJ,0))
- End DoDot:1
- +12 DO LOADSIG^TIUBR1(TIUDADD,.TIUL)
- +13 QUIT
- +14 ;
- SETREC(TIUGDATA) ; Sets docmt header line Patname, SSN, [Location, Visit]
- +1 ; Requires TIUGDATA
- +2 NEW Y
- +3 SET Y=$$SETSTR^VALM1($$NAME^TIULS($GET(TIU("PNM")),"LAST,FI MI"),$GET(Y),1,15)
- +4 SET Y=$$SETSTR^VALM1($GET(TIU("SSN")),$GET(Y),16,12)
- +5 ; ---- If TIUDA is an ID entry, write ID, ADDENDED? in header
- +6 ; and leave out entry-specific info (Location, Visit)
- +7 ; since that goes with each individual entry: ----
- +8 IF $PIECE(TIUGDATA,U,2)!$PIECE(TIUGDATA,U,3)
- Begin DoDot:1
- +9 SET Y=$$SETSTR^VALM1("Interdisciplinary "_$SELECT($PIECE(TIUGDATA,U,2):"Note",1:"Entry"),$GET(Y),29,23)
- +10 IF $PIECE(TIUGDATA,U,2)
- SET Y=$$SETSTR^VALM1("ADDENDED?"_$SELECT($$HASADDEN^TIULC1(+TIUDA,1):" Yes",1:" No"),$GET(Y),66,13)
- End DoDot:1
- GOTO SETRX
- +11 SET Y=$$SETSTR^VALM1($PIECE($GET(TIU("LOC")),U,2),$GET(Y),30,17)
- +12 IF $LENGTH($GET(TIU("WARD")))
- Begin DoDot:1
- +13 SET Y=$$SETSTR^VALM1("Adm: "_$$DATE^TIULS(+TIU("EDT"),"MM/DD/CCYY"),$GET(Y),48,15)
- +14 SET Y=$$SETSTR^VALM1("Dis: "_$$DATE^TIULS(+TIU("LDT"),"MM/DD/CCYY"),$GET(Y),65,15)
- End DoDot:1
- +15 IF '$LENGTH($GET(TIU("WARD")))
- Begin DoDot:1
- +16 SET Y=$$SETSTR^VALM1("Visit Date: "_$$DATE^TIULS(+$GET(TIU("EDT")),"MM/DD/CCYY HR:MIN"),$GET(Y),51,28)
- End DoDot:1
- SETRX QUIT Y
- +1 ;
- CLEAN ; Die, filthy spawn!!!
- +1 DO CLEAN^VALM10
- KILL VALMHDR,TIU,TIUPRM0,TIUPRM1,TIUGDATA
- +2 QUIT