TIUSRVA.m

TIUSRVA ; SLC/JER,AJB - API's for Authorization ; 4/2/09 12:34pm

 ;;1.0;TEXT INTEGRATION UTILITIES;**19,28,47,80,100,116,152,160,178,175,157,236,234,239**;Jun 20, 1997;Build 4

 ;

 ;External reference to File ^AUPNVSIT supported by DBIA 3580

REQCOS(TIUY,TIUTYP,TIUDA,TIUSER,TIUDT) ; Evaluate cosignature requirement

 ; Initialize return value

 N TIUDPRM

 S TIUY=0

 I +$G(TIUTYP)'>0,'+$G(TIUDA) Q

 I +$G(TIUDA) S TIUTYP=+$G(^TIU(8925,+$G(TIUDA),0))

 S:'+$G(TIUSER) TIUSER=+$G(DUZ)

 ; VMP/RJT --- *239  - Make sure only date is being passed into REQCOSIG and not date/time

 S TIUY=+$$REQCOSIG^TIULP(TIUTYP,+$G(TIUDA),+$G(TIUSER),$P(+$G(TIUDT),"."))

 Q

URGENCY(TIUY) ; -- retrieve set values from dd for discharge summary urgency

 N TIUDD,TIUI,TIUX

 D FIELD^DID(8925,.09,"","POINTER","TIUDD")

 F TIUI=1:1 S TIUX=$P(TIUDD("POINTER"),";",TIUI) Q:TIUX=""   S TIUY(TIUI)=$TR(TIUX,":","^")

 Q

CANDO(TIUY,TIUDA,TIUACT) ; Boolean function to evaluate privilege

 N TIUPOP,TIUDPRM S TIUPOP=0

 ; **152** prevent editing completed [uncosigned] documents.

 I $P($G(^TIU(8925,TIUDA,0)),U,5)>5,(TIUACT="EDIT RECORD") S TIUY="0^ You may not edit uncosigned or completed documents" Q

 I $S(TIUACT["SIGN":1,TIUACT="EDIT RECORD":1,TIUACT="DELETE RECORD":1,1:0) D  Q:+TIUPOP=1

 . L +^TIU(8925,+TIUDA):1

 . E  S TIUY="0^ Another session is editing this entry.",TIUPOP=1

 . L -^TIU(8925,+TIUDA)

 ;VMP/ELR *239 -- CHANGED TIUACT["SIGN" TO TIUACT["SIGNAT" - WAS EXECUTING LINE FOR INDENTIFYING SIGNERS

  I TIUACT["SIGNAT",+$$NEEDCS(TIUDA) S TIUY="0^ You must name a cosigner before signing this document." Q

 S TIUY=$$CANDO^TIULP(TIUDA,TIUACT)

 Q

NEEDCS(TIUDA) ; Does user need a cosigner?

 N TIUD0,TIUD12,TIUY,SIGNER,COSIGNER,XTRASGNR

 S TIUD0=$G(^TIU(8925,TIUDA,0)),TIUD12=$G(^(12))

 S SIGNER=$P(TIUD12,U,4),COSIGNER=$P(TIUD12,U,8),XTRASGNR=0

 I (DUZ'=SIGNER),(DUZ'=COSIGNER) S XTRASGNR=+$O(^TIU(8925.7,"AE",+TIUDA,+DUZ,0))

 I +XTRASGNR S TIUY=0

 E  I +$$REQCOSIG^TIULP(+TIUD0,TIUDA,DUZ),(+$P(TIUD12,U,8)'>0) S TIUY=1

 Q +$G(TIUY)

USRINACT(TIUY,TIUDA) ; Is user inactive?

 S TIUY=+$$GET1^DIQ(200,TIUDA_",",7,"I")

 Q

AUTHSIGN(TIUY,TIUDA,TIUUSR) ; Has Author signed?

 ; if TIUY = 

 ; 0 = Author has NOT signed & TIUUSR = Expected Cosigner

 ; 1 = Author HAS signed or TIUUSR '= Expected Cosigner

 ;

 N TIUD12,TIUD15

 S TIUD12=$G(^TIU(8925,TIUDA,12)),TIUD15=$G(^(15))

 S TIUY=1

 D:$P(TIUD12,U,8)=TIUUSR  Q

 . S:$P(TIUD12,U,2)'=$P(TIUD15,U,2) TIUY=0

 Q

TIUVISIT(TIUY,DOCTYP,DFN,VISIT) ;  Check for a 1 time only doc

 ;  TIUY    =    return value

 ;          = 0 if can add more than one or none already exist

 ;          = 1 if cannot add more than one and one already exists

 ;  DOCTYP  =    Pointer to ^TUI(8925.1,   TIU DOCUMENT DEFINITION

 ;  DFN     =    Patient IEN

 ;  VISIT   =    Visit String "LOC;VDATE;VTYP"

 I $$PATCH^XPDUTL("OR*3.0*195") D

 . Q:($G(DOCTYP)="")!($G(DFN)="")!($G(VISIT)="")

 . N TIUDPRM,TIUTEST

 . D DOCPRM^TIULC1(DOCTYP,.TIUDPRM)

 . S TIUY=$S($P(TIUDPRM(0),U,10)="":1,1:$P(TIUDPRM(0),U,10))

 . I TIUY=1 S TIUY=0 Q

 . I $L(VISIT,";")=3 D

 . . S TIUTEST=$$EXIST^TIUEDI3(DFN,DOCTYP,VISIT)

 . . I TIUTEST S TIUY=1

 . . I 'TIUTEST S TIUY=0

 I '$$PATCH^XPDUTL("OR*3.0*195") D

 . Q:($G(DOCTYP)="")!($G(DFN)="")!($G(VISIT)="")

 . N TIUX3

 . S TIUX3=+$O(^TIU(8925.95,"B",DOCTYP,""))

 . S TIUY=$P($G(^TIU(8925.95,TIUX3,0)),U,10) S TIUY=$S(TIUY=0:1,1:0)

 . Q:'TIUY

 . S VISIT=((9999999-$P(VISIT,"."))_"."_$P(VISIT,".",2))

 . S VISIT=+$O(^AUPNVSIT("AA",DFN,VISIT,""))

 . S TIUY=$S($D(^TIU(8925,"AV",DFN,DOCTYP,VISIT)):0,1:1)

 . S TIUY=$S(TIUY=0:1,1:0)

 Q

WHATACT(TIUY,TIUDA) ; Evaluate/return whether signature or cosignature

 N TIUD0,TIUD12,TIUSTAT,SIGNER,COSIGNER,XTRASGNR

 S TIUD0=$G(^TIU(8925,+TIUDA,0)),TIUD12=$G(^TIU(8925,+TIUDA,12))

 S SIGNER=$P(TIUD12,U,4),COSIGNER=$P(TIUD12,U,8)

 I (DUZ'=SIGNER),(DUZ'=COSIGNER) S XTRASGNR=+$O(^TIU(8925.7,"AE",+TIUDA,+DUZ,0))

 I '$G(XTRASGNR) S XTRASGNR=$$ASURG^TIUADSIG(TIUDA)

 S TIUSTAT=+$P(TIUD0,U,5)

 S TIUY=$S(TIUSTAT'>5:"SIGNATURE",+$G(XTRASGNR):"SIGNATURE",1:"COSIGNATURE")

 Q

CANCHCOS(TIUY,TIUDA) ; Evaluate/return whether user can change cosigner

 S TIUY=$$MAYCHNG^TIURA1(TIUDA)

 Q

NEEDJUST(TIUY,TIUDA) ; Is justification required for deletion?

 N TIUD0 S TIUD0=$G(^TIU(8925,+TIUDA,0)),TIUY=0

 I +$P(TIUD0,U,5)'<6 S TIUY=1

 Q

GETTITLE(TIUY,TIUDA) ; Get the title from a TIU Document Record

 S TIUY=+$G(^TIU(8925,+TIUDA,0))

 Q

CANATTCH(TIUY,TIUDA) ; Can this document be attached as an ID Child

 N TITLEDA,PARENTDA

 S TITLEDA=+$G(^TIU(8925,TIUDA,0))

 I TITLEDA'>0 S TIUY="0^Document #"_TIUDA_" does not exist." Q

 S PARENTDA=+$G(^TIU(8925,TIUDA,21))

 S TIUY=$$POSSPRNT^TIULP(TITLEDA)

 I +TIUY S TIUY="-1"_U_$P(TIUY,U,2) Q

 I +$$ISCWAD^TIULX(TITLEDA) D  Q

 . S TIUY="0^ CWAD Documents may not be Attached as Interdisciplinary Entries."

 I +$$ISA^TIULX(TITLEDA,+$$CLASS^TIUCNSLT) D  Q

 . S TIUY="0^ Consult Results may not be Attached as Interdisciplinary Entries."

 S TIUY=$$CANDO^TIULP(TIUDA,"ATTACH TO ID NOTE")

 I PARENTDA D  ; action must be "detach"

 . I 'TIUY S TIUY="0^ You may not detach this note from an interdisciplinary note." Q

 . S TIUY=$$CANDO^TIULP(PARENTDA,"ATTACH ID ENTRY")

 . I 'TIUY S TIUY="0^ You may not detach this note from its interdisciplinary note."

 Q

CANRCV(TIUY,TIUDA) ; Can this document receive an ID Child?

 S TIUY=$$CANDO^TIULP(TIUDA,"ATTACH ID ENTRY")

 Q

TIUSRVA   ; SLC/JER,AJB - API's for Authorization ; 4/2/09 12:34pm

 +1       ;;1.0;TEXT INTEGRATION UTILITIES;**19,28,47,80,100,116,152,160,178,175,157,236,234,239**;Jun 20, 1997;Build 4

 +2       ;

 +3       ;External reference to File ^AUPNVSIT supported by DBIA 3580

REQCOS(TIUY,TIUTYP,TIUDA,TIUSER,TIUDT) ; Evaluate cosignature requirement

 +1       ; Initialize return value

 +2        NEW TIUDPRM

 +3        SET TIUY=0

 +4        IF +$GET(TIUTYP)'>0

               IF '+$GET(TIUDA)

                   QUIT 

 +5        IF +$GET(TIUDA)

               SET TIUTYP=+$GET(^TIU(8925,+$GET(TIUDA),0))

 +6        IF '+$GET(TIUSER)

               SET TIUSER=+$GET(DUZ)

 +7       ; VMP/RJT --- *239  - Make sure only date is being passed into REQCOSIG and not date/time

 +8        SET TIUY=+$$REQCOSIG^TIULP(TIUTYP,+$GET(TIUDA),+$GET(TIUSER),$PIECE(+$GET(TIUDT),"."))

 +9        QUIT 

URGENCY(TIUY) ; -- retrieve set values from dd for discharge summary urgency

 +1        NEW TIUDD,TIUI,TIUX

 +2        DO FIELD^DID(8925,.09,"","POINTER","TIUDD")

 +3        FOR TIUI=1:1

               SET TIUX=$PIECE(TIUDD("POINTER"),";",TIUI)

               IF TIUX=""

                   QUIT 

               SET TIUY(TIUI)=$TRANSLATE(TIUX,":","^")

 +4        QUIT 

CANDO(TIUY,TIUDA,TIUACT) ; Boolean function to evaluate privilege

 +1        NEW TIUPOP,TIUDPRM

           SET TIUPOP=0

 +2       ; **152** prevent editing completed [uncosigned] documents.

 +3        IF $PIECE($GET(^TIU(8925,TIUDA,0)),U,5)>5

               IF (TIUACT="EDIT RECORD")

                   SET TIUY="0^ You may not edit uncosigned or completed documents"

                   QUIT 

 +4        IF $SELECT(TIUACT["SIGN":1,TIUACT="EDIT RECORD":1,TIUACT="DELETE RECORD":1,1:0)

               Begin DoDot:1

 +5                LOCK +^TIU(8925,+TIUDA):1

 +6               IF '$TEST

                       SET TIUY="0^ Another session is editing this entry."

                       SET TIUPOP=1

 +7                LOCK -^TIU(8925,+TIUDA)

               End DoDot:1

               IF +TIUPOP=1

                   QUIT 

 +8       ;VMP/ELR *239 -- CHANGED TIUACT["SIGN" TO TIUACT["SIGNAT" - WAS EXECUTING LINE FOR INDENTIFYING SIGNERS

 +9        IF TIUACT["SIGNAT"

               IF +$$NEEDCS(TIUDA)

                   SET TIUY="0^ You must name a cosigner before signing this document."

                   QUIT 

 +10       SET TIUY=$$CANDO^TIULP(TIUDA,TIUACT)

 +11       QUIT 

NEEDCS(TIUDA) ; Does user need a cosigner?

 +1        NEW TIUD0,TIUD12,TIUY,SIGNER,COSIGNER,XTRASGNR

 +2        SET TIUD0=$GET(^TIU(8925,TIUDA,0))

           SET TIUD12=$GET(^(12))

 +3        SET SIGNER=$PIECE(TIUD12,U,4)

           SET COSIGNER=$PIECE(TIUD12,U,8)

           SET XTRASGNR=0

 +4        IF (DUZ'=SIGNER)

               IF (DUZ'=COSIGNER)

                   SET XTRASGNR=+$ORDER(^TIU(8925.7,"AE",+TIUDA,+DUZ,0))

 +5        IF +XTRASGNR

               SET TIUY=0

 +6       IF '$TEST

               IF +$$REQCOSIG^TIULP(+TIUD0,TIUDA,DUZ)

                   IF (+$PIECE(TIUD12,U,8)'>0)

                       SET TIUY=1

 +7        QUIT +$GET(TIUY)

USRINACT(TIUY,TIUDA) ; Is user inactive?

 +1        SET TIUY=+$$GET1^DIQ(200,TIUDA_",",7,"I")

 +2        QUIT 

AUTHSIGN(TIUY,TIUDA,TIUUSR) ; Has Author signed?

 +1       ; if TIUY = 

 +2       ; 0 = Author has NOT signed & TIUUSR = Expected Cosigner

 +3       ; 1 = Author HAS signed or TIUUSR '= Expected Cosigner

 +4       ;

 +5        NEW TIUD12,TIUD15

 +6        SET TIUD12=$GET(^TIU(8925,TIUDA,12))

           SET TIUD15=$GET(^(15))

 +7        SET TIUY=1

 +8        IF $PIECE(TIUD12,U,8)=TIUUSR

               Begin DoDot:1

 +9                IF $PIECE(TIUD12,U,2)'=$PIECE(TIUD15,U,2)

                       SET TIUY=0

               End DoDot:1

           QUIT 

 +10       QUIT 

TIUVISIT(TIUY,DOCTYP,DFN,VISIT) ;  Check for a 1 time only doc

 +1       ;  TIUY    =    return value

 +2       ;          = 0 if can add more than one or none already exist

 +3       ;          = 1 if cannot add more than one and one already exists

 +4       ;  DOCTYP  =    Pointer to ^TUI(8925.1,   TIU DOCUMENT DEFINITION

 +5       ;  DFN     =    Patient IEN

 +6       ;  VISIT   =    Visit String "LOC;VDATE;VTYP"

 +7        IF $$PATCH^XPDUTL("OR*3.0*195")

               Begin DoDot:1

 +8                IF ($GET(DOCTYP)="")!($GET(DFN)="")!($GET(VISIT)="")

                       QUIT 

 +9                NEW TIUDPRM,TIUTEST

 +10               DO DOCPRM^TIULC1(DOCTYP,.TIUDPRM)

 +11               SET TIUY=$SELECT($PIECE(TIUDPRM(0),U,10)="":1,1:$PIECE(TIUDPRM(0),U,10))

 +12               IF TIUY=1

                       SET TIUY=0

                       QUIT 

 +13               IF $LENGTH(VISIT,";")=3

                       Begin DoDot:2

 +14                       SET TIUTEST=$$EXIST^TIUEDI3(DFN,DOCTYP,VISIT)

 +15                       IF TIUTEST

                               SET TIUY=1

 +16                       IF 'TIUTEST

                               SET TIUY=0

                       End DoDot:2

               End DoDot:1

 +17       IF '$$PATCH^XPDUTL("OR*3.0*195")

               Begin DoDot:1

 +18               IF ($GET(DOCTYP)="")!($GET(DFN)="")!($GET(VISIT)="")

                       QUIT 

 +19               NEW TIUX3

 +20               SET TIUX3=+$ORDER(^TIU(8925.95,"B",DOCTYP,""))

 +21               SET TIUY=$PIECE($GET(^TIU(8925.95,TIUX3,0)),U,10)

                   SET TIUY=$SELECT(TIUY=0:1,1:0)

 +22               IF 'TIUY

                       QUIT 

 +23               SET VISIT=((9999999-$PIECE(VISIT,"."))_"."_$PIECE(VISIT,".",2))

 +24               SET VISIT=+$ORDER(^AUPNVSIT("AA",DFN,VISIT,""))

 +25               SET TIUY=$SELECT($DATA(^TIU(8925,"AV",DFN,DOCTYP,VISIT)):0,1:1)

 +26               SET TIUY=$SELECT(TIUY=0:1,1:0)

               End DoDot:1

 +27       QUIT 

WHATACT(TIUY,TIUDA) ; Evaluate/return whether signature or cosignature

 +1        NEW TIUD0,TIUD12,TIUSTAT,SIGNER,COSIGNER,XTRASGNR

 +2        SET TIUD0=$GET(^TIU(8925,+TIUDA,0))

           SET TIUD12=$GET(^TIU(8925,+TIUDA,12))

 +3        SET SIGNER=$PIECE(TIUD12,U,4)

           SET COSIGNER=$PIECE(TIUD12,U,8)

 +4        IF (DUZ'=SIGNER)

               IF (DUZ'=COSIGNER)

                   SET XTRASGNR=+$ORDER(^TIU(8925.7,"AE",+TIUDA,+DUZ,0))

 +5        IF '$GET(XTRASGNR)

               SET XTRASGNR=$$ASURG^TIUADSIG(TIUDA)

 +6        SET TIUSTAT=+$PIECE(TIUD0,U,5)

 +7        SET TIUY=$SELECT(TIUSTAT'>5:"SIGNATURE",+$GET(XTRASGNR):"SIGNATURE",1:"COSIGNATURE")

 +8        QUIT 

CANCHCOS(TIUY,TIUDA) ; Evaluate/return whether user can change cosigner

 +1        SET TIUY=$$MAYCHNG^TIURA1(TIUDA)

 +2        QUIT 

NEEDJUST(TIUY,TIUDA) ; Is justification required for deletion?

 +1        NEW TIUD0

           SET TIUD0=$GET(^TIU(8925,+TIUDA,0))

           SET TIUY=0

 +2        IF +$PIECE(TIUD0,U,5)'<6

               SET TIUY=1

 +3        QUIT 

GETTITLE(TIUY,TIUDA) ; Get the title from a TIU Document Record

 +1        SET TIUY=+$GET(^TIU(8925,+TIUDA,0))

 +2        QUIT 

CANATTCH(TIUY,TIUDA) ; Can this document be attached as an ID Child

 +1        NEW TITLEDA,PARENTDA

 +2        SET TITLEDA=+$GET(^TIU(8925,TIUDA,0))

 +3        IF TITLEDA'>0

               SET TIUY="0^Document #"_TIUDA_" does not exist."

               QUIT 

 +4        SET PARENTDA=+$GET(^TIU(8925,TIUDA,21))

 +5        SET TIUY=$$POSSPRNT^TIULP(TITLEDA)

 +6        IF +TIUY

               SET TIUY="-1"_U_$PIECE(TIUY,U,2)

               QUIT 

 +7        IF +$$ISCWAD^TIULX(TITLEDA)

               Begin DoDot:1

 +8                SET TIUY="0^ CWAD Documents may not be Attached as Interdisciplinary Entries."

               End DoDot:1

               QUIT 

 +9        IF +$$ISA^TIULX(TITLEDA,+$$CLASS^TIUCNSLT)

               Begin DoDot:1

 +10               SET TIUY="0^ Consult Results may not be Attached as Interdisciplinary Entries."

               End DoDot:1

               QUIT 

 +11       SET TIUY=$$CANDO^TIULP(TIUDA,"ATTACH TO ID NOTE")

 +12      ; action must be "detach"

           IF PARENTDA

               Begin DoDot:1

 +13               IF 'TIUY

                       SET TIUY="0^ You may not detach this note from an interdisciplinary note."

                       QUIT 

 +14               SET TIUY=$$CANDO^TIULP(PARENTDA,"ATTACH ID ENTRY")

 +15               IF 'TIUY

                       SET TIUY="0^ You may not detach this note from its interdisciplinary note."

               End DoDot:1

 +16       QUIT 

CANRCV(TIUY,TIUDA) ; Can this document receive an ID Child?

 +1        SET TIUY=$$CANDO^TIULP(TIUDA,"ATTACH ID ENTRY")

 +2        QUIT