TIULC ; SLC/JER - Computational functions ;08/06/2009
;;1.0;TEXT INTEGRATION UTILITIES;**3,9,19,23,53,93,109,182,250**;Jun 20, 1997;Build 14
;
; ICR #2054 - ^%DT
; #10000 - NOW^%DTC Routine & %H, %I Local Vars
; #10003 - %DT Local Var
; #10103 - $$FMDIFF^XLFDT
;
LINECNT(DA) ; Compute line count for document record
N CPL,CCNT S CPL=$S(+$P($G(TIUPRM0),U,3)>0:$P(TIUPRM0,U,3),1:60)
Q $$CHARCNT(DA)\CPL
CHARCNT(DA) ; Compute character count for a record
N TIUI
N:'$D(CCNT) CCNT ; Character count is static
S TIUI=0 F S TIUI=$O(^TIU(8925,DA,"TEXT",TIUI)) Q:+TIUI'>0 D
. S CCNT=+$G(CCNT)+$L($$STRIP^TIULS(^TIU(8925,DA,"TEXT",TIUI,0)))
S TIUI=0
F S TIUI=$O(^TIU(8925,"DAD",DA,TIUI)) Q:+TIUI'>0!+$$ISADDNDM^TIULC1(+TIUI) S CCNT=$$CHARCNT(TIUI)
Q +$G(CCNT)
VBCLINES(DA,ROOT) ; Compute the Visible Black Character (VBC) Line Count for a document
Q $FN(($$VBCCNT(DA,$G(ROOT,"^TIU(8925,"_DA_",""TEXT"")"))/65),"",2)
VBCCNT(DA,ROOT) ; Compute Visible Black Character (VBC) Count for a record
N TIUVBC,TIUI S ROOT=$G(ROOT,"^TIU(8925,"_DA_",""TEXT"")")
N:'$D(VBCCNT) VBCCNT
S TIUVBC=$$VBC
S TIUI=0
F S TIUI=$O(@ROOT@(TIUI)) Q:+TIUI'>0 D
. N TIUL,TIUJ S TIUL=$G(@ROOT@(TIUI,0)),TIUJ=0
. F TIUJ=1:1:$L(TIUL) D
. . N TIUC S TIUC=$E(TIUL,TIUJ)
. . S:TIUVBC[TIUC VBCCNT=+$G(VBCCNT)+1
S TIUI=0
I ROOT["^TIU(8925," D
. F S TIUI=$O(^TIU(8925,"DAD",DA,TIUI)) Q:+TIUI'>0!+$$ISADDNDM^TIULC1(+TIUI) S CCNT=$$VBCCNT(TIUI)
Q +$G(VBCCNT)
VBC() ; Return string of Visible Black Characters (VBC)
Q "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz~!@#$%^&*()_+{}|:<>?÷±`1234567890-=[]\;',./"""
STATUS(DA) ; Evaluate Status of Reports
N NODE12,NODE13,NODE15,NODE16,AMENDED,STATUS,SIGNED,COSIGNED,PURGED
N VERIFIED,RELEASED,SIGNER,COSIGNER,SIGSTAT,TYPE,REQVER,REQREL,REQCOS
N DELETED,TIUDPARM,ADMINCL
S STATUS=""
S TYPE=$S($D(TIUTYP(1)):$P(TIUTYP(1),U,2),1:+$G(^TIU(8925,+DA,0)))
D DOCPRM^TIULC1(TYPE,.TIUDPARM,DA)
S REQVER=$$REQVER(+DA,+$P($G(TIUDPARM(0)),U,3))
S REQREL=+$P($G(TIUDPARM(0)),U,2)
S NODE12=$G(^TIU(8925,+DA,12)),NODE13=$G(^TIU(8925,+DA,13))
S NODE15=$G(^TIU(8925,+DA,15)),NODE16=$G(^TIU(8925,+DA,16))
S SIGNED=+$P(NODE15,U),COSIGNED=+$P(NODE15,U,7),REQCOS=+$P(NODE15,U,6)
S SIGNER=+$P(NODE12,U,2),COSIGNER=+$P(NODE12,U,4)
S ADMINCL=+$P(NODE16,U,6) ;P182
S AMENDED=+$P(NODE16,U),PURGED=+$P(NODE16,U,9),DELETED=+$P(NODE16,U,11)
S RELEASED=+$P(NODE13,U,4),VERIFIED=+$P(NODE13,U,5)
I PURGED S STATUS="purged" G STATUSX
I DELETED S STATUS="deleted" G STATUSX
I AMENDED S STATUS="amended" G STATUSX
I +$$ISA^TIULX(+TYPE,+$$CLASS^TIUCP),'SIGNER S STATUS="undictated" G STATUSX
I '+NODE12,+NODE13 S STATUS="untranscribed" G STATUSX
I REQREL,'RELEASED S STATUS="unreleased" G STATUSX
I REQVER,'VERIFIED S STATUS="unverified" G STATUSX
I SIGNED,$S('REQCOS:1,COSIGNED:1,1:0) S STATUS="completed" G STATUSX
I ADMINCL S STATUS="completed" G STATUSX
I 'SIGNED S STATUS="unsigned" G STATUSX
I REQCOS,'COSIGNED S STATUS="uncosigned"
STATUSX Q STATUS
REQVER(TIUDA,TIUVPRM) ; Evaluate conditions of verification requirement
N TIUD0,TIUD13,TIUD15,TIUY
S TIUD0=$G(^TIU(8925,+TIUDA,0)),TIUD13=$G(^(13)),TIUD15=$G(^(15))
I +$G(TIUVPRM)'>0!(+$P(TIUD13,U,5)>0) S TIUY=0 G REQVX
I +$G(TIUVPRM)>0,+$G(TIUD15) S TIUY=0 G REQVX
I +$G(TIUVPRM)=1 S TIUY=1 G REQVX
I +$G(TIUVPRM)=2,($P(TIUD13,U,3)="U") S TIUY=1 G REQVX
I +$G(TIUVPRM)=3,($P(TIUD13,U,3)="D") S TIUY=1
REQVX Q +$G(TIUY)
PRCDNC(DA,SCREEN) ; Determine sort precedence of each record
N SIGNED,URGENCY
S URGENCY=$P($G(^TIU(8925,+DA,0)),U,9)
I +$$SIGNED(DA,.SCREEN)'>0 S Y=$S(URGENCY="P":1,1:2)
E S Y=3
Q Y
PURGE(TIUDA) ; Checks whether or not a given Document should be purged
N TIUEDT,TIUY S TIUY=0
; if parameters not in symbol table, get them
I '$D(TIUPRM0) D SETPARM^TIULE
; exit if no Archive/purge grace period defined
I +$P(TIUPRM0,U,4)'>0 G PURGEX
S TIUEDT=$P($G(^TIU(8925,TIUDA,12)),U)
I +TIUEDT'>0 G PURGEX ;Transcription date blank
I +$$ISPN^TIULX(+$G(^TIU(8925,+TIUDA,0))) G PURGEX ; PN's exempt
I +$$ISADDNDM^TIULC1(+TIUDA),+$$ISPN^TIULX(+$G(^TIU(8925,+$P(^TIU(8925,+TIUDA,0),U,6),0))) G PURGEX ; Addenda to Progress Notes exempt
I +$P($G(^TIU(8925,+TIUDA,0)),U,5)<7 G PURGEX ;Incomplete--don't purge
I +$P($G(^TIU(8925,TIUDA,16)),U,4)>0 G PURGEX ;Document already purged
I $$FMDIFF^XLFDT(DT,TIUEDT)>+$P(TIUPRM0,U,4) S TIUY=1
PURGEX Q TIUY
OVERDUE(TIUDA) ; Checks whether or not a given document is overdue
N TIUD0,TIUDATE,TIUY,TIUDPRM S TIUY=0,TIUD0=$G(^TIU(8925,TIUDA,0))
; if parameters not in symbol table, get them
I '$D(TIUPRM0) D SETPARM^TIULE
D DOCPRM^TIULC1(+TIUD0,.TIUDPRM,TIUDA)
; exit if no signature grace period defined
I +$P(TIUPRM0,U,5)'>0 G OVERX
I '$D(TIUDPRM) G OVERX
S TIUDATE=$S($$REQVER(TIUDA,+$P(TIUDPRM(0),U,3)):$P($G(^TIU(8925,+TIUDA,13)),U,5),$P(TIUDPRM(0),U,2):$P($G(^TIU(8925,+TIUDA,13)),U,4),1:$P($G(^TIU(8925,+TIUDA,12)),U))
G:+TIUDATE'>0 OVERX
I $$FMDIFF^XLFDT(DT,TIUDATE)>$P(TIUPRM0,U,5),(+$P($G(^TIU(8925,+TIUDA,0)),U,5)>4),(+$P($G(^TIU(8925,+TIUDA,0)),U,5)<7) S TIUY=1
OVERX Q TIUY
NOW() ; Extrinsic function returning current date/time to nearest .01 second
N %,%H,%I,X
D NOW^%DTC
Q %
IDATE(X) ; Recieves date in external format, returns internal format
N %DT,Y
I ($L(X," ")=2),(X?1.2N1P1.2N1P1.2N1" "1.2N.E) S X=$TR(X," ","@")
S %DT="TSP" D ^%DT
Q Y
SIGNED(TIUDA,SCREEN) ; Check whether document requires signature or
; cosignature on user-sensitive basis
N Y S Y=0 ; Initialize return value to FALSE
; If archived/purged return TRUE
I +$P($G(^TIU(8925,+TIUDA,16)),U,9) S Y=1 G SIGNEDX
; If OPTION is Act on MY Unsigned Documents, check
; whether his/her signature is present
I $P($G(SCREEN(1)),U)="AAU",($P($G(SCREEN(2)),U)="ASUP") D G SIGNEDX
. ; If dictated by user and signed return TRUE
. I $P($G(^TIU(8925,+TIUDA,12)),U,4)=DUZ,(+$P($G(^(15)),U)>0) S Y=1
. ; If user is Expected Cosigner and cosigned, return TRUE
. I $P($G(^TIU(8925,+TIUDA,12)),U,8)=DUZ,(+$P($G(^(15)),U,7)>0) S Y=1
; Otherwise check search criteria to determine signature status
I $P($G(SCREEN(1)),U)="AAU",+$P($G(^TIU(8925,+TIUDA,15)),U) S Y=1 G SIGNEDX
I $P($G(SCREEN(1)),U)="ASUP",+$P($G(^TIU(8925,+TIUDA,15)),U,7) S Y=1 G SIGNEDX
I +$P($G(^TIU(8925,+TIUDA,15)),U),+$P($G(^(15)),U,7) S Y=1
SIGNEDX Q Y
BLANK(TIUDA) ; Reads a given document for blank lines
; Returns: 1:Record contains 1 or more blanks
; 0:Record contains no blanks
N BLANK,TIUI,Y S (TIUI,Y)=0
I '$D(TIUPRM1) D SETPARM^TIULE
I $P($G(TIUPRM1),U,6)']"" G BLANKX
S BLANK=$P(TIUPRM1,U,6)
F S TIUI=$O(^TIU(8925,TIUDA,"TEXT",TIUI)) Q:+TIUI'>0 D
. I $G(^TIU(8925,TIUDA,"TEXT",TIUI,0))[BLANK S Y=1
BLANKX Q Y
CHKSUM(TIUROOT,TIUY) ; Calculates checksum for a record
N TIUI,X S TIUI=0,TIUY=+$G(TIUY)
F S TIUI=$O(@TIUROOT@(TIUI)) Q:+TIUI'>0 D
. S X=$G(@TIUROOT@(TIUI,0))
. N TIUJ
. F TIUJ=1:1:$L(X) S TIUY=+$G(TIUY)+(($A(X,TIUJ)*TIUI)*TIUJ)
S TIUI=0
F S TIUI=$O(^TIU(8925,"DAD",+$P(TIUROOT,",",2),TIUI)) Q:+TIUI'>0 D
. I +$$ISADDNDM^TIULC1(+TIUI) Q
. S TIUY=+$G(TIUY)+$$CHKSUM("^TIU(8925,"_+TIUI_",""TEXT"")",TIUY)
Q +$G(TIUY)
TIULC ; SLC/JER - Computational functions ;08/06/2009
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**3,9,19,23,53,93,109,182,250**;Jun 20, 1997;Build 14
+2 ;
+3 ; ICR #2054 - ^%DT
+4 ; #10000 - NOW^%DTC Routine & %H, %I Local Vars
+5 ; #10003 - %DT Local Var
+6 ; #10103 - $$FMDIFF^XLFDT
+7 ;
LINECNT(DA) ; Compute line count for document record
+1 NEW CPL,CCNT
SET CPL=$SELECT(+$PIECE($GET(TIUPRM0),U,3)>0:$PIECE(TIUPRM0,U,3),1:60)
+2 QUIT $$CHARCNT(DA)\CPL
CHARCNT(DA) ; Compute character count for a record
+1 NEW TIUI
+2 ; Character count is static
IF '$DATA(CCNT)
NEW CCNT
+3 SET TIUI=0
FOR
SET TIUI=$ORDER(^TIU(8925,DA,"TEXT",TIUI))
IF +TIUI'>0
QUIT
Begin DoDot:1
+4 SET CCNT=+$GET(CCNT)+$LENGTH($$STRIP^TIULS(^TIU(8925,DA,"TEXT",TIUI,0)))
End DoDot:1
+5 SET TIUI=0
+6 FOR
SET TIUI=$ORDER(^TIU(8925,"DAD",DA,TIUI))
IF +TIUI'>0!+$$ISADDNDM^TIULC1(+TIUI)
QUIT
SET CCNT=$$CHARCNT(TIUI)
+7 QUIT +$GET(CCNT)
VBCLINES(DA,ROOT) ; Compute the Visible Black Character (VBC) Line Count for a document
+1 QUIT $FNUMBER(($$VBCCNT(DA,$GET(ROOT,"^TIU(8925,"_DA_",""TEXT"")"))/65),"",2)
VBCCNT(DA,ROOT) ; Compute Visible Black Character (VBC) Count for a record
+1 NEW TIUVBC,TIUI
SET ROOT=$GET(ROOT,"^TIU(8925,"_DA_",""TEXT"")")
+2 IF '$DATA(VBCCNT)
NEW VBCCNT
+3 SET TIUVBC=$$VBC
+4 SET TIUI=0
+5 FOR
SET TIUI=$ORDER(@ROOT@(TIUI))
IF +TIUI'>0
QUIT
Begin DoDot:1
+6 NEW TIUL,TIUJ
SET TIUL=$GET(@ROOT@(TIUI,0))
SET TIUJ=0
+7 FOR TIUJ=1:1:$LENGTH(TIUL)
Begin DoDot:2
+8 NEW TIUC
SET TIUC=$EXTRACT(TIUL,TIUJ)
+9 IF TIUVBC[TIUC
SET VBCCNT=+$GET(VBCCNT)+1
End DoDot:2
End DoDot:1
+10 SET TIUI=0
+11 IF ROOT["^TIU(8925,"
Begin DoDot:1
+12 FOR
SET TIUI=$ORDER(^TIU(8925,"DAD",DA,TIUI))
IF +TIUI'>0!+$$ISADDNDM^TIULC1(+TIUI)
QUIT
SET CCNT=$$VBCCNT(TIUI)
End DoDot:1
+13 QUIT +$GET(VBCCNT)
VBC() ; Return string of Visible Black Characters (VBC)
+1 QUIT "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz~!@#$%^&*()_+{}|:<>?÷±`1234567890-=[]\;',./"""
STATUS(DA) ; Evaluate Status of Reports
+1 NEW NODE12,NODE13,NODE15,NODE16,AMENDED,STATUS,SIGNED,COSIGNED,PURGED
+2 NEW VERIFIED,RELEASED,SIGNER,COSIGNER,SIGSTAT,TYPE,REQVER,REQREL,REQCOS
+3 NEW DELETED,TIUDPARM,ADMINCL
+4 SET STATUS=""
+5 SET TYPE=$SELECT($DATA(TIUTYP(1)):$PIECE(TIUTYP(1),U,2),1:+$GET(^TIU(8925,+DA,0)))
+6 DO DOCPRM^TIULC1(TYPE,.TIUDPARM,DA)
+7 SET REQVER=$$REQVER(+DA,+$PIECE($GET(TIUDPARM(0)),U,3))
+8 SET REQREL=+$PIECE($GET(TIUDPARM(0)),U,2)
+9 SET NODE12=$GET(^TIU(8925,+DA,12))
SET NODE13=$GET(^TIU(8925,+DA,13))
+10 SET NODE15=$GET(^TIU(8925,+DA,15))
SET NODE16=$GET(^TIU(8925,+DA,16))
+11 SET SIGNED=+$PIECE(NODE15,U)
SET COSIGNED=+$PIECE(NODE15,U,7)
SET REQCOS=+$PIECE(NODE15,U,6)
+12 SET SIGNER=+$PIECE(NODE12,U,2)
SET COSIGNER=+$PIECE(NODE12,U,4)
+13 ;P182
SET ADMINCL=+$PIECE(NODE16,U,6)
+14 SET AMENDED=+$PIECE(NODE16,U)
SET PURGED=+$PIECE(NODE16,U,9)
SET DELETED=+$PIECE(NODE16,U,11)
+15 SET RELEASED=+$PIECE(NODE13,U,4)
SET VERIFIED=+$PIECE(NODE13,U,5)
+16 IF PURGED
SET STATUS="purged"
GOTO STATUSX
+17 IF DELETED
SET STATUS="deleted"
GOTO STATUSX
+18 IF AMENDED
SET STATUS="amended"
GOTO STATUSX
+19 IF +$$ISA^TIULX(+TYPE,+$$CLASS^TIUCP)
IF 'SIGNER
SET STATUS="undictated"
GOTO STATUSX
+20 IF '+NODE12
IF +NODE13
SET STATUS="untranscribed"
GOTO STATUSX
+21 IF REQREL
IF 'RELEASED
SET STATUS="unreleased"
GOTO STATUSX
+22 IF REQVER
IF 'VERIFIED
SET STATUS="unverified"
GOTO STATUSX
+23 IF SIGNED
IF $SELECT('REQCOS:1,COSIGNED:1,1:0)
SET STATUS="completed"
GOTO STATUSX
+24 IF ADMINCL
SET STATUS="completed"
GOTO STATUSX
+25 IF 'SIGNED
SET STATUS="unsigned"
GOTO STATUSX
+26 IF REQCOS
IF 'COSIGNED
SET STATUS="uncosigned"
STATUSX QUIT STATUS
REQVER(TIUDA,TIUVPRM) ; Evaluate conditions of verification requirement
+1 NEW TIUD0,TIUD13,TIUD15,TIUY
+2 SET TIUD0=$GET(^TIU(8925,+TIUDA,0))
SET TIUD13=$GET(^(13))
SET TIUD15=$GET(^(15))
+3 IF +$GET(TIUVPRM)'>0!(+$PIECE(TIUD13,U,5)>0)
SET TIUY=0
GOTO REQVX
+4 IF +$GET(TIUVPRM)>0
IF +$GET(TIUD15)
SET TIUY=0
GOTO REQVX
+5 IF +$GET(TIUVPRM)=1
SET TIUY=1
GOTO REQVX
+6 IF +$GET(TIUVPRM)=2
IF ($PIECE(TIUD13,U,3)="U")
SET TIUY=1
GOTO REQVX
+7 IF +$GET(TIUVPRM)=3
IF ($PIECE(TIUD13,U,3)="D")
SET TIUY=1
REQVX QUIT +$GET(TIUY)
PRCDNC(DA,SCREEN) ; Determine sort precedence of each record
+1 NEW SIGNED,URGENCY
+2 SET URGENCY=$PIECE($GET(^TIU(8925,+DA,0)),U,9)
+3 IF +$$SIGNED(DA,.SCREEN)'>0
SET Y=$SELECT(URGENCY="P":1,1:2)
+4 IF '$TEST
SET Y=3
+5 QUIT Y
PURGE(TIUDA) ; Checks whether or not a given Document should be purged
+1 NEW TIUEDT,TIUY
SET TIUY=0
+2 ; if parameters not in symbol table, get them
+3 IF '$DATA(TIUPRM0)
DO SETPARM^TIULE
+4 ; exit if no Archive/purge grace period defined
+5 IF +$PIECE(TIUPRM0,U,4)'>0
GOTO PURGEX
+6 SET TIUEDT=$PIECE($GET(^TIU(8925,TIUDA,12)),U)
+7 ;Transcription date blank
IF +TIUEDT'>0
GOTO PURGEX
+8 ; PN's exempt
IF +$$ISPN^TIULX(+$GET(^TIU(8925,+TIUDA,0)))
GOTO PURGEX
+9 ; Addenda to Progress Notes exempt
IF +$$ISADDNDM^TIULC1(+TIUDA)
IF +$$ISPN^TIULX(+$GET(^TIU(8925,+$PIECE(^TIU(8925,+TIUDA,0),U,6),0)))
GOTO PURGEX
+10 ;Incomplete--don't purge
IF +$PIECE($GET(^TIU(8925,+TIUDA,0)),U,5)<7
GOTO PURGEX
+11 ;Document already purged
IF +$PIECE($GET(^TIU(8925,TIUDA,16)),U,4)>0
GOTO PURGEX
+12 IF $$FMDIFF^XLFDT(DT,TIUEDT)>+$PIECE(TIUPRM0,U,4)
SET TIUY=1
PURGEX QUIT TIUY
OVERDUE(TIUDA) ; Checks whether or not a given document is overdue
+1 NEW TIUD0,TIUDATE,TIUY,TIUDPRM
SET TIUY=0
SET TIUD0=$GET(^TIU(8925,TIUDA,0))
+2 ; if parameters not in symbol table, get them
+3 IF '$DATA(TIUPRM0)
DO SETPARM^TIULE
+4 DO DOCPRM^TIULC1(+TIUD0,.TIUDPRM,TIUDA)
+5 ; exit if no signature grace period defined
+6 IF +$PIECE(TIUPRM0,U,5)'>0
GOTO OVERX
+7 IF '$DATA(TIUDPRM)
GOTO OVERX
+8 SET TIUDATE=$SELECT($$REQVER(TIUDA,+$PIECE(TIUDPRM(0),U,3)):$PIECE($GET(^TIU(8925,+TIUDA,13)),U,5),$PIECE(TIUDPRM(0),U,2):$PIECE($GET(^TIU(8925,+TIUDA,13)),U,4),1:$PIECE($GET(^TIU(8925,+TIUDA,12)),U))
+9 IF +TIUDATE'>0
GOTO OVERX
+10 IF $$FMDIFF^XLFDT(DT,TIUDATE)>$PIECE(TIUPRM0,U,5)
IF (+$PIECE($GET(^TIU(8925,+TIUDA,0)),U,5)>4)
IF (+$PIECE($GET(^TIU(8925,+TIUDA,0)),U,5)<7)
SET TIUY=1
OVERX QUIT TIUY
NOW() ; Extrinsic function returning current date/time to nearest .01 second
+1 NEW %,%H,%I,X
+2 DO NOW^%DTC
+3 QUIT %
IDATE(X) ; Recieves date in external format, returns internal format
+1 NEW %DT,Y
+2 IF ($LENGTH(X," ")=2)
IF (X?1.2N1P1.2N1P1.2N1" "1.2N.E)
SET X=$TRANSLATE(X," ","@")
+3 SET %DT="TSP"
DO ^%DT
+4 QUIT Y
SIGNED(TIUDA,SCREEN) ; Check whether document requires signature or
+1 ; cosignature on user-sensitive basis
+2 ; Initialize return value to FALSE
NEW Y
SET Y=0
+3 ; If archived/purged return TRUE
+4 IF +$PIECE($GET(^TIU(8925,+TIUDA,16)),U,9)
SET Y=1
GOTO SIGNEDX
+5 ; If OPTION is Act on MY Unsigned Documents, check
+6 ; whether his/her signature is present
+7 IF $PIECE($GET(SCREEN(1)),U)="AAU"
IF ($PIECE($GET(SCREEN(2)),U)="ASUP")
Begin DoDot:1
+8 ; If dictated by user and signed return TRUE
+9 IF $PIECE($GET(^TIU(8925,+TIUDA,12)),U,4)=DUZ
IF (+$PIECE($GET(^(15)),U)>0)
SET Y=1
+10 ; If user is Expected Cosigner and cosigned, return TRUE
+11 IF $PIECE($GET(^TIU(8925,+TIUDA,12)),U,8)=DUZ
IF (+$PIECE($GET(^(15)),U,7)>0)
SET Y=1
End DoDot:1
GOTO SIGNEDX
+12 ; Otherwise check search criteria to determine signature status
+13 IF $PIECE($GET(SCREEN(1)),U)="AAU"
IF +$PIECE($GET(^TIU(8925,+TIUDA,15)),U)
SET Y=1
GOTO SIGNEDX
+14 IF $PIECE($GET(SCREEN(1)),U)="ASUP"
IF +$PIECE($GET(^TIU(8925,+TIUDA,15)),U,7)
SET Y=1
GOTO SIGNEDX
+15 IF +$PIECE($GET(^TIU(8925,+TIUDA,15)),U)
IF +$PIECE($GET(^(15)),U,7)
SET Y=1
SIGNEDX QUIT Y
BLANK(TIUDA) ; Reads a given document for blank lines
+1 ; Returns: 1:Record contains 1 or more blanks
+2 ; 0:Record contains no blanks
+3 NEW BLANK,TIUI,Y
SET (TIUI,Y)=0
+4 IF '$DATA(TIUPRM1)
DO SETPARM^TIULE
+5 IF $PIECE($GET(TIUPRM1),U,6)']""
GOTO BLANKX
+6 SET BLANK=$PIECE(TIUPRM1,U,6)
+7 FOR
SET TIUI=$ORDER(^TIU(8925,TIUDA,"TEXT",TIUI))
IF +TIUI'>0
QUIT
Begin DoDot:1
+8 IF $GET(^TIU(8925,TIUDA,"TEXT",TIUI,0))[BLANK
SET Y=1
End DoDot:1
BLANKX QUIT Y
CHKSUM(TIUROOT,TIUY) ; Calculates checksum for a record
+1 NEW TIUI,X
SET TIUI=0
SET TIUY=+$GET(TIUY)
+2 FOR
SET TIUI=$ORDER(@TIUROOT@(TIUI))
IF +TIUI'>0
QUIT
Begin DoDot:1
+3 SET X=$GET(@TIUROOT@(TIUI,0))
+4 NEW TIUJ
+5 FOR TIUJ=1:1:$LENGTH(X)
SET TIUY=+$GET(TIUY)+(($ASCII(X,TIUJ)*TIUI)*TIUJ)
End DoDot:1
+6 SET TIUI=0
+7 FOR
SET TIUI=$ORDER(^TIU(8925,"DAD",+$PIECE(TIUROOT,",",2),TIUI))
IF +TIUI'>0
QUIT
Begin DoDot:1
+8 IF +$$ISADDNDM^TIULC1(+TIUI)
QUIT
+9 SET TIUY=+$GET(TIUY)+$$CHKSUM("^TIU(8925,"_+TIUI_",""TEXT"")",TIUY)
End DoDot:1
+10 QUIT +$GET(TIUY)
