- 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)
