- TIUSRVPT ; SLC/JER - Set Methods for Documents ;03/02/10 09:59
- ;;1.0;TEXT INTEGRATION UTILITIES;**122,175,186,210,223,250**;Jun 20, 1997;Build 14
- ;
- ; ICR #10018 - DIE Routine & DIE, DR, & DA Local Vars
- ; #10103 - $$FMADD^XLFDT,$$NOW^XLFDT
- ;
- SETTEXT(TIUY,TIUDA,TIUX,SUPPRESS) ; Save Text - use Buffered I/O
- N PAGES,PAGE S TIUY=0,SUPPRESS=$G(SUPPRESS,0)
- I $S(+$G(TIUDA)'>0:1,'$D(^TIU(8925,+TIUDA,0)):1,1:0) D Q
- . S TIUY="0^0^0^Attempt to file data in a Nonexistent Entry."
- . D ERROR(TIUY)
- S PAGE=$P($G(TIUX("HDR")),U),PAGES=$P($G(TIUX("HDR")),U,2)
- I $S('PAGE:1,'PAGES:1,1:0) D Q
- . S TIUY="0^0^0^Invalid text block header"
- . D ERROR(TIUY)
- ; I PAGE=1 D MERGTEMP^TIUEDI1(TIUDA) K ^TIU(8925,+TIUDA,"TEMP"),^("TEXT")
- I PAGE=1 K ^TIU(8925,+TIUDA,"TEMP")
- M ^TIU(8925,+TIUDA,"TEMP")=TIUX("TEXT")
- ;if done, commit changes
- I 'SUPPRESS,(PAGE=PAGES),$D(^TIU(8925,TIUDA,"TEMP")) D
- . N TIUC,TIUI,TIU,TIUD12,TIUAU,TIUEC S (TIUC,TIUI)=0
- . F S TIUI=$O(^TIU(8925,TIUDA,"TEMP",TIUI)) Q:+TIUI'>0 D
- . . S TIUC=TIUC+1
- . I TIUC>0 S ^TIU(8925,TIUDA,"TEMP",0)="^^"_TIUC_U_TIUC_U_DT_"^^"
- . D GETTIU^TIULD(.TIU,TIUDA)
- . K ^TIU(8925,TIUDA,"TEXT")
- . S TIUC=0 F S TIUC=$O(^TIU(8925,"DAD",TIUDA,TIUC)) Q:+TIUC'>0 D
- . . I +$$ISADDNDM^TIULC1(+TIUC) Q
- . . K ^TIU(8925,+TIUC,"TEXT")
- . D MERGTEXT^TIUEDI1(+TIUDA,.TIU)
- . K ^TIU(8925,TIUDA,"TEMP")
- . ; If user is neither author or expected cosigner, file VBC Line count
- . S TIUD12=$G(^TIU(8925,TIUDA,12)),TIUAU=$P(TIUD12,U,2),TIUEC=$P(TIUD12,U,8)
- . I (TIUAU]""),(DUZ'=TIUAU) D
- . . I (TIUEC]""),(DUZ=TIUEC) Q
- . . D LINES(TIUDA)
- ; Acknowledge success / ask for next page
- S TIUY=TIUDA_U_PAGE_U_PAGES
- Q
- LINES(DA) ; Compute/file VBC Line count
- N DIE,DR S DIE="^TIU(8925,",DR=".1///"_$$LINECNT^TIULC(DA)_";1801///"_$$VBCLINES^TIULC(+DA)
- D ^DIE
- Q
- ADMNCLOS(TIUY,TIUDA,MODE,PERSON) ; Post Administrative Closure Information
- N TIUX,TIUI,TIUCLBY,TIUCLTTL,TIUCAPT
- I '$D(^TIU(8925,TIUDA)) S TIUY="0^Attempt to file data in a Nonexistent Entry." Q
- S MODE=$G(MODE,"S")
- S TIUCAPT=$S("ES"[MODE:" Electronically Filed: ",1:"Administrative Closure: ")
- S PERSON=$G(PERSON,DUZ)
- S TIUCLBY=$$SIGNAME^TIULS(PERSON)
- S TIUCLTTL=$$SIGTITL^TIULS(PERSON)
- S TIUX(.05)=7
- S TIUX(1606)=$G(DT)
- S TIUX(1607)=TIUCLBY
- S TIUX(1608)=TIUCLTTL
- S TIUX(1613)=MODE
- D FILE^TIUSRVP(.TIUY,TIUDA,.TIUX)
- S TIUI=$P($G(^TIU(8925,TIUDA,"TEXT",0)),U,3)+1
- ;If scanned document set document body to informational text
- I MODE="S" D
- . S ^TIU(8925,+TIUDA,"TEXT",TIUI,0)=" ",TIUI=TIUI+1
- . S ^TIU(8925,+TIUDA,"TEXT",TIUI,0)=" *** SCANNED DOCUMENT ***",TIUI=TIUI+1
- . S ^TIU(8925,+TIUDA,"TEXT",TIUI,0)=" SIGNATURE NOT REQUIRED",TIUI=TIUI+1
- . S ^TIU(8925,+TIUDA,"TEXT",TIUI,0)=" ",TIUI=TIUI+1
- S ^TIU(8925,TIUDA,"TEXT",TIUI,0)=" ",TIUI=TIUI+1
- S ^TIU(8925,TIUDA,"TEXT",TIUI,0)=TIUCAPT_$$DATE^TIULS(DT,"MM/DD/CCYY"),TIUI=TIUI+1
- S ^TIU(8925,TIUDA,"TEXT",TIUI,0)=" by: "_TIUCLBY,TIUI=TIUI+1
- S ^TIU(8925,TIUDA,"TEXT",TIUI,0)=" "_TIUCLTTL
- S ^TIU(8925,+TIUDA,"TEXT",0)="^^"_TIUI_U_TIUI_U_DT_"^^"
- D ALERTDEL^TIUALRT(TIUDA)
- ; post-signature action for administratively closed docs
- N TIUCONS,TIUSTIS,TIUTTL,TIUPSIG,DA S TIUCONS=-1
- D ISCNSLT^TIUCNSLT(.TIUCONS,+$G(^TIU(8925,TIUDA,0)))
- S TIUSTIS=$P($G(^TIU(8925,TIUDA,0)),U,5)
- S TIUTTL=+$G(^TIU(8925,+TIUDA,0)),TIUPSIG=$$POSTSIGN^TIULC1(TIUTTL)
- I +$L(TIUPSIG) S DA=TIUDA X TIUPSIG
- I TIUCONS,TIUSTIS=7,$$HASKIDS^TIUSRVLI(TIUDA) D
- . N SEQUENCE,TIUKIDS,TIUINT,TIUK
- . S SEQUENCE="D",TIUKIDS="TIUKIDS",TIUINT=0,TIUK=0
- . D SETKIDS^TIUSRVLI(TIUKIDS,TIUDA,TIUINT)
- . F S TIUK=$O(TIUKIDS(TIUK)) Q:'TIUK D
- . . I $P(TIUKIDS(TIUK),U,7)="completed" X TIUPSIG
- Q
- ERROR(ECODE) ; Register AUTOSAVE Error
- N ERRDT S ERRDT=+$$NOW^XLFDT
- Q:+$G(^XTMP("TIUERR","COUNT"))'<100
- I '$D(^XTMP("TIUERR",0)) D
- . S ^XTMP("TIUERR",0)=$$FMADD^XLFDT(DT,90)_U_DT
- S ^XTMP("TIUERR",ERRDT,"ECODE")=ECODE
- S ^XTMP("TIUERR",ERRDT,"USER")=DUZ
- S ^XTMP("TIUERR",ERRDT,"TIUDA")=$G(TIUDA,"UNDEFINED")
- S ^XTMP("TIUERR",ERRDT,"TIUHDR")=$G(TIUX("HDR"))
- S ^XTMP("TIUERR",ERRDT,"XWBHDR")=$G(XWBS1("HDR"))
- S ^XTMP("TIUERR","COUNT")=$G(^XTMP("TIUERR","COUNT"))+1
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUSRVPT 4294 printed Feb 19, 2025@00:12:29 Page 2
- TIUSRVPT ; SLC/JER - Set Methods for Documents ;03/02/10 09:59
- +1 ;;1.0;TEXT INTEGRATION UTILITIES;**122,175,186,210,223,250**;Jun 20, 1997;Build 14
- +2 ;
- +3 ; ICR #10018 - DIE Routine & DIE, DR, & DA Local Vars
- +4 ; #10103 - $$FMADD^XLFDT,$$NOW^XLFDT
- +5 ;
- SETTEXT(TIUY,TIUDA,TIUX,SUPPRESS) ; Save Text - use Buffered I/O
- +1 NEW PAGES,PAGE
- SET TIUY=0
- SET SUPPRESS=$GET(SUPPRESS,0)
- +2 IF $SELECT(+$GET(TIUDA)'>0:1,'$DATA(^TIU(8925,+TIUDA,0)):1,1:0)
- Begin DoDot:1
- +3 SET TIUY="0^0^0^Attempt to file data in a Nonexistent Entry."
- +4 DO ERROR(TIUY)
- End DoDot:1
- QUIT
- +5 SET PAGE=$PIECE($GET(TIUX("HDR")),U)
- SET PAGES=$PIECE($GET(TIUX("HDR")),U,2)
- +6 IF $SELECT('PAGE:1,'PAGES:1,1:0)
- Begin DoDot:1
- +7 SET TIUY="0^0^0^Invalid text block header"
- +8 DO ERROR(TIUY)
- End DoDot:1
- QUIT
- +9 ; I PAGE=1 D MERGTEMP^TIUEDI1(TIUDA) K ^TIU(8925,+TIUDA,"TEMP"),^("TEXT")
- +10 IF PAGE=1
- KILL ^TIU(8925,+TIUDA,"TEMP")
- +11 MERGE ^TIU(8925,+TIUDA,"TEMP")=TIUX("TEXT")
- +12 ;if done, commit changes
- +13 IF 'SUPPRESS
- IF (PAGE=PAGES)
- IF $DATA(^TIU(8925,TIUDA,"TEMP"))
- Begin DoDot:1
- +14 NEW TIUC,TIUI,TIU,TIUD12,TIUAU,TIUEC
- SET (TIUC,TIUI)=0
- +15 FOR
- SET TIUI=$ORDER(^TIU(8925,TIUDA,"TEMP",TIUI))
- if +TIUI'>0
- QUIT
- Begin DoDot:2
- +16 SET TIUC=TIUC+1
- End DoDot:2
- +17 IF TIUC>0
- SET ^TIU(8925,TIUDA,"TEMP",0)="^^"_TIUC_U_TIUC_U_DT_"^^"
- +18 DO GETTIU^TIULD(.TIU,TIUDA)
- +19 KILL ^TIU(8925,TIUDA,"TEXT")
- +20 SET TIUC=0
- FOR
- SET TIUC=$ORDER(^TIU(8925,"DAD",TIUDA,TIUC))
- if +TIUC'>0
- QUIT
- Begin DoDot:2
- +21 IF +$$ISADDNDM^TIULC1(+TIUC)
- QUIT
- +22 KILL ^TIU(8925,+TIUC,"TEXT")
- End DoDot:2
- +23 DO MERGTEXT^TIUEDI1(+TIUDA,.TIU)
- +24 KILL ^TIU(8925,TIUDA,"TEMP")
- +25 ; If user is neither author or expected cosigner, file VBC Line count
- +26 SET TIUD12=$GET(^TIU(8925,TIUDA,12))
- SET TIUAU=$PIECE(TIUD12,U,2)
- SET TIUEC=$PIECE(TIUD12,U,8)
- +27 IF (TIUAU]"")
- IF (DUZ'=TIUAU)
- Begin DoDot:2
- +28 IF (TIUEC]"")
- IF (DUZ=TIUEC)
- QUIT
- +29 DO LINES(TIUDA)
- End DoDot:2
- End DoDot:1
- +30 ; Acknowledge success / ask for next page
- +31 SET TIUY=TIUDA_U_PAGE_U_PAGES
- +32 QUIT
- LINES(DA) ; Compute/file VBC Line count
- +1 NEW DIE,DR
- SET DIE="^TIU(8925,"
- SET DR=".1///"_$$LINECNT^TIULC(DA)_";1801///"_$$VBCLINES^TIULC(+DA)
- +2 DO ^DIE
- +3 QUIT
- ADMNCLOS(TIUY,TIUDA,MODE,PERSON) ; Post Administrative Closure Information
- +1 NEW TIUX,TIUI,TIUCLBY,TIUCLTTL,TIUCAPT
- +2 IF '$DATA(^TIU(8925,TIUDA))
- SET TIUY="0^Attempt to file data in a Nonexistent Entry."
- QUIT
- +3 SET MODE=$GET(MODE,"S")
- +4 SET TIUCAPT=$SELECT("ES"[MODE:" Electronically Filed: ",1:"Administrative Closure: ")
- +5 SET PERSON=$GET(PERSON,DUZ)
- +6 SET TIUCLBY=$$SIGNAME^TIULS(PERSON)
- +7 SET TIUCLTTL=$$SIGTITL^TIULS(PERSON)
- +8 SET TIUX(.05)=7
- +9 SET TIUX(1606)=$GET(DT)
- +10 SET TIUX(1607)=TIUCLBY
- +11 SET TIUX(1608)=TIUCLTTL
- +12 SET TIUX(1613)=MODE
- +13 DO FILE^TIUSRVP(.TIUY,TIUDA,.TIUX)
- +14 SET TIUI=$PIECE($GET(^TIU(8925,TIUDA,"TEXT",0)),U,3)+1
- +15 ;If scanned document set document body to informational text
- +16 IF MODE="S"
- Begin DoDot:1
- +17 SET ^TIU(8925,+TIUDA,"TEXT",TIUI,0)=" "
- SET TIUI=TIUI+1
- +18 SET ^TIU(8925,+TIUDA,"TEXT",TIUI,0)=" *** SCANNED DOCUMENT ***"
- SET TIUI=TIUI+1
- +19 SET ^TIU(8925,+TIUDA,"TEXT",TIUI,0)=" SIGNATURE NOT REQUIRED"
- SET TIUI=TIUI+1
- +20 SET ^TIU(8925,+TIUDA,"TEXT",TIUI,0)=" "
- SET TIUI=TIUI+1
- End DoDot:1
- +21 SET ^TIU(8925,TIUDA,"TEXT",TIUI,0)=" "
- SET TIUI=TIUI+1
- +22 SET ^TIU(8925,TIUDA,"TEXT",TIUI,0)=TIUCAPT_$$DATE^TIULS(DT,"MM/DD/CCYY")
- SET TIUI=TIUI+1
- +23 SET ^TIU(8925,TIUDA,"TEXT",TIUI,0)=" by: "_TIUCLBY
- SET TIUI=TIUI+1
- +24 SET ^TIU(8925,TIUDA,"TEXT",TIUI,0)=" "_TIUCLTTL
- +25 SET ^TIU(8925,+TIUDA,"TEXT",0)="^^"_TIUI_U_TIUI_U_DT_"^^"
- +26 DO ALERTDEL^TIUALRT(TIUDA)
- +27 ; post-signature action for administratively closed docs
- +28 NEW TIUCONS,TIUSTIS,TIUTTL,TIUPSIG,DA
- SET TIUCONS=-1
- +29 DO ISCNSLT^TIUCNSLT(.TIUCONS,+$GET(^TIU(8925,TIUDA,0)))
- +30 SET TIUSTIS=$PIECE($GET(^TIU(8925,TIUDA,0)),U,5)
- +31 SET TIUTTL=+$GET(^TIU(8925,+TIUDA,0))
- SET TIUPSIG=$$POSTSIGN^TIULC1(TIUTTL)
- +32 IF +$LENGTH(TIUPSIG)
- SET DA=TIUDA
- XECUTE TIUPSIG
- +33 IF TIUCONS
- IF TIUSTIS=7
- IF $$HASKIDS^TIUSRVLI(TIUDA)
- Begin DoDot:1
- +34 NEW SEQUENCE,TIUKIDS,TIUINT,TIUK
- +35 SET SEQUENCE="D"
- SET TIUKIDS="TIUKIDS"
- SET TIUINT=0
- SET TIUK=0
- +36 DO SETKIDS^TIUSRVLI(TIUKIDS,TIUDA,TIUINT)
- +37 FOR
- SET TIUK=$ORDER(TIUKIDS(TIUK))
- if 'TIUK
- QUIT
- Begin DoDot:2
- +38 IF $PIECE(TIUKIDS(TIUK),U,7)="completed"
- XECUTE TIUPSIG
- End DoDot:2
- End DoDot:1
- +39 QUIT
- ERROR(ECODE) ; Register AUTOSAVE Error
- +1 NEW ERRDT
- SET ERRDT=+$$NOW^XLFDT
- +2 if +$GET(^XTMP("TIUERR","COUNT"))'<100
- QUIT
- +3 IF '$DATA(^XTMP("TIUERR",0))
- Begin DoDot:1
- +4 SET ^XTMP("TIUERR",0)=$$FMADD^XLFDT(DT,90)_U_DT
- End DoDot:1
- +5 SET ^XTMP("TIUERR",ERRDT,"ECODE")=ECODE
- +6 SET ^XTMP("TIUERR",ERRDT,"USER")=DUZ
- +7 SET ^XTMP("TIUERR",ERRDT,"TIUDA")=$GET(TIUDA,"UNDEFINED")
- +8 SET ^XTMP("TIUERR",ERRDT,"TIUHDR")=$GET(TIUX("HDR"))
- +9 SET ^XTMP("TIUERR",ERRDT,"XWBHDR")=$GET(XWBS1("HDR"))
- +10 SET ^XTMP("TIUERR","COUNT")=$GET(^XTMP("TIUERR","COUNT"))+1
- +11 QUIT