- TIULA3 ; SLC/JER - Still more interactive functions ;1/31/08
- ;;1.0;TEXT INTEGRATION UTILITIES;**50,79,98,219**;Jun 20, 1997;Build 11
- TITLE ; Title Look-up
- N TIUI,TYPE,TIUCLASS S TIUI=0
- S TIUTYP=$NA(^TMP("TIUTYP",$J))
- K @TIUTYP
- I +$G(TIUPICT)'>0 Q
- I $P($G(TIUPICT(1)),U,4)="ALL" D
- . S TIUCLASS=+$O(^TIU(8925.1,"AD",+$P(TIUPICT(1),U,2),0))
- . K TIUPICT
- . S TIUPICT=1,TIUPICT(1)="1^"_TIUCLASS_U_$$PNAME^TIULC1(TIUCLASS)
- F S TIUI=$O(TIUPICT(TIUI)) Q:+TIUI'>0 D
- . S TIUCLASS=$P(TIUPICT(TIUI),U,2)
- . W !!,"For ",$$UP^XLFSTR($$PNAME^TIULC1(TIUCLASS)),": "
- . D TITLPICK(.TYPE,TIUCLASS)
- M @TIUTYP=TYPE
- S Y="ANY"
- Q
- TITLPICK(TIUTYP,CLASS) ; Select multiple titles
- N TIUI,TYPE,TIUPRMT S TIUI=0
- W !!,"Please Select the ",$$UP^XLFSTR($$PNAME^TIULC1(CLASS))
- W " TITLES to search for:",!
- F D Q:+$G(TYPE)'>0
- . K TYPE
- . S TIUI=TIUI+1,TIUPRMT=$J(TIUI,3)_") "
- . D DOCSPICK^TIULA2(.TYPE,CLASS,"A",0,TIUPRMT)
- . I +TYPE>0 S TIUTYP=+$G(TIUTYP)+1,TIUTYP(TIUTYP)=$G(TYPE(1))
- . I I $P(TYPE(1),U,4)="SINGLE ITEM" D
- . . W !,"There is only one TITLE under ",$$UP^XLFSTR($$PNAME^TIULC1(CLASS))
- . . S TYPE=0
- . I $S($D(DTOUT):1,$D(DUOUT):1,(+TYPE'>0&'$D(TIUTYP)):1,1:0) S TIUQUIT=1
- W !
- Q
- ASKTITLE(CLASS,TIUTTL) ; Ask for a different title, same class
- N TIUY,TIUTYP,DFLT,SCREEN,X,Y
- S DFLT=$$RSLVTITL(TIUTTL)
- S SCREEN="I $P(^TIU(8925.1,+Y,0),U,4)=""DOC"",($P(^(0),U)'[""ADDENDUM""),+$$ISA^TIULX(+Y,CLASS),+$$CANPICK^TIULP(+Y),+$$CANENTR^TIULP(+Y)"
- S TIUY=+$$ASKTYP^TIULA2(+CLASS,DFLT,SCREEN,"TITLE: ")
- I +$G(TIUY)'>0 S TIUY=TIUTTL
- Q TIUY
- RSLVTITL(TIUTTL) ; Resolve pointers to titles
- Q $P($G(^TIU(8925.1,+TIUTTL,0)),U)
- ASKSEQ(TIUDFLT) ; Ask preferred sort sequence
- N TIUPRMT,TIUSET,TIUY S TIUDFLT=$G(TIUDFLT,"D")
- S TIUPRMT="Please Specify Sort Order: "
- S TIUSET="A:ascending (OLDEST FIRST);D:descending (NEWEST FIRST)"
- S TIUY=$$READ^TIUU("SA^"_TIUSET,TIUPRMT,$S(TIUDFLT="A":"ascending",1:"descending"))
- Q TIUY
- DATENOTE(X) ; Ask for date/time of note
- N %DT,Y
- ;S TIUPRMT="DATE/TIME OF NOTE"
- ;S TIUY=$$READ^TIUU("D^:NOW:RS",TIUPRMT,$G(DFLT,"NOW"),TIUHLP)
- ;I +TIUY W " ",$P(TIUY,U,2)
- S %DT="RSX",%DT(0)="-NOW" D ^%DT
- I +Y'>0 D
- . W !,$C(7),"Enter DATE AND TIME of the note [TIME REQUIRED] (future dates prohibited)."
- Q +$G(Y)
- SCRCSNR(TIUDA,Y) ; Evaluate whether a person may be selected to cosign
- N TIUI,TIUY,TIUD0,TIUD12 S TIUY=1 ; most people may be selected
- S TIUD0=$G(^TIU(8925,+TIUDA,0)),TIUD12=$G(^TIU(8925,+TIUDA,12))
- ; If he requires cosignature for this document a user may NOT select
- ; himself
- I +$$REQCOSIG^TIULP(+TIUD0,+TIUDA,+$G(DUZ)),(Y=+$G(DUZ)) S TIUY=0 G SCREENX
- ; A TERMINATED User may NOT be selected
- I +$$ACTIVE^XUSER(+Y)'>0 S TIUY=0 G SCREENX
- ; A non-PROVIDER may NOT be selected
- I +$$PROVIDER^TIUPXAP1(+Y,DT)'>0 S TIUY=0 G SCREENX
- ; Author may NOT be selected
- I Y=+$P(TIUD12,U,2) S TIUY=0 G SCREENX
- ; Expected Signer may NOT be selected
- I Y=+$P(TIUD12,U,4) S TIUY=0 G SCREENX
- ; Others who require Cosignature may NOT be selected
- I +$$REQCOSIG^TIULP(+TIUD0,+TIUDA,+Y) S TIUY=0
- SCREENX Q +$G(TIUY)
- ;
- SCRATT(TIUDA,PERSON) ; Can a person be an Attending for a given docmt?
- N TIUD0,TIUTYP,CANSEL,DICTDT,TIUISDS,TIUPRNT,TIUPTYP,TIUPD0,TIUISAD
- S PERSON=+PERSON,TIUDA=+TIUDA,CANSEL=1
- S TIUD0=$G(^TIU(8925,TIUDA,0)),TIUPRNT=+$P(TIUD0,U,6)
- S DICTDT=+$P($G(^TIU(8925,+TIUDA,13)),U,7)
- I DICTDT>0 S DICTDT=$P(DICTDT,".")
- ; Is Docmt an Addendum, a DS?
- S TIUTYP=+TIUD0,(TIUPTYP,TIUISAD)=0
- I TIUPRNT>0 S TIUPTYP=+$G(^TIU(8925,TIUPRNT,0))
- I TIUPTYP>0,$P($G(^TIU(8925.1,TIUTYP,0)),U)["ADDENDUM" S TIUISAD=1
- S TIUISDS=+$S('TIUISAD:$$ISDS^TIULX(TIUTYP),1:$$ISDS^TIULX(TIUPTYP))
- ; A TERMINATED (as of NOW) User may NOT be selected:
- I $$ISTERM^USRLM(PERSON) S CANSEL=0 G SCRATTX
- ; If not DS, is person an active provider?
- I 'TIUISDS S:'$$PROVIDER^TIUPXAP1(PERSON,DT) CANSEL=0 G SCRATTX
- ; TIUDA is a DS:
- ; Attendings must be in USR Class PROVIDER NOW:
- I '$$ISA^USRLM(+PERSON,"PROVIDER") S CANSEL=0 G SCRATTX
- ; Persons who require Cosignature on Dictation Dt may NOT be selected:
- I +$$REQCOSIG^TIULP(TIUTYP,+TIUDA,PERSON,DICTDT) S CANSEL=0
- SCRATTX Q +$G(CANSEL)
- ;
- SCRDFCS(USER,Y) ; Screen Default Cosigner selection for USER
- N TIUY S TIUY=1
- S USER=$G(USER,DUZ)
- ; A user may NOT select himself
- I Y=USER S TIUY=0 G SCRDFX
- ; A TERMINATED User may NOT be selected
- I +$$ACTIVE^XUSER(+Y)'>0 S TIUY=0 G SCREENX
- ; A non-PROVIDER may NOT be selected
- I +$$PROVIDER^TIUPXAP1(+Y,DT)'>0 S TIUY=0 G SCREENX
- SCRDFX Q TIUY
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIULA3 4576 printed Feb 19, 2025@00:08:30 Page 2
- TIULA3 ; SLC/JER - Still more interactive functions ;1/31/08
- +1 ;;1.0;TEXT INTEGRATION UTILITIES;**50,79,98,219**;Jun 20, 1997;Build 11
- TITLE ; Title Look-up
- +1 NEW TIUI,TYPE,TIUCLASS
- SET TIUI=0
- +2 SET TIUTYP=$NAME(^TMP("TIUTYP",$JOB))
- +3 KILL @TIUTYP
- +4 IF +$GET(TIUPICT)'>0
- QUIT
- +5 IF $PIECE($GET(TIUPICT(1)),U,4)="ALL"
- Begin DoDot:1
- +6 SET TIUCLASS=+$ORDER(^TIU(8925.1,"AD",+$PIECE(TIUPICT(1),U,2),0))
- +7 KILL TIUPICT
- +8 SET TIUPICT=1
- SET TIUPICT(1)="1^"_TIUCLASS_U_$$PNAME^TIULC1(TIUCLASS)
- End DoDot:1
- +9 FOR
- SET TIUI=$ORDER(TIUPICT(TIUI))
- if +TIUI'>0
- QUIT
- Begin DoDot:1
- +10 SET TIUCLASS=$PIECE(TIUPICT(TIUI),U,2)
- +11 WRITE !!,"For ",$$UP^XLFSTR($$PNAME^TIULC1(TIUCLASS)),": "
- +12 DO TITLPICK(.TYPE,TIUCLASS)
- End DoDot:1
- +13 MERGE @TIUTYP=TYPE
- +14 SET Y="ANY"
- +15 QUIT
- TITLPICK(TIUTYP,CLASS) ; Select multiple titles
- +1 NEW TIUI,TYPE,TIUPRMT
- SET TIUI=0
- +2 WRITE !!,"Please Select the ",$$UP^XLFSTR($$PNAME^TIULC1(CLASS))
- +3 WRITE " TITLES to search for:",!
- +4 FOR
- Begin DoDot:1
- +5 KILL TYPE
- +6 SET TIUI=TIUI+1
- SET TIUPRMT=$JUSTIFY(TIUI,3)_") "
- +7 DO DOCSPICK^TIULA2(.TYPE,CLASS,"A",0,TIUPRMT)
- +8 IF +TYPE>0
- SET TIUTYP=+$GET(TIUTYP)+1
- SET TIUTYP(TIUTYP)=$GET(TYPE(1))
- +9 IF $TEST
- IF $PIECE(TYPE(1),U,4)="SINGLE ITEM"
- Begin DoDot:2
- +10 WRITE !,"There is only one TITLE under ",$$UP^XLFSTR($$PNAME^TIULC1(CLASS))
- +11 SET TYPE=0
- End DoDot:2
- +12 IF $SELECT($DATA(DTOUT):1,$DATA(DUOUT):1,(+TYPE'>0&'$DATA(TIUTYP)):1,1:0)
- SET TIUQUIT=1
- End DoDot:1
- if +$GET(TYPE)'>0
- QUIT
- +13 WRITE !
- +14 QUIT
- ASKTITLE(CLASS,TIUTTL) ; Ask for a different title, same class
- +1 NEW TIUY,TIUTYP,DFLT,SCREEN,X,Y
- +2 SET DFLT=$$RSLVTITL(TIUTTL)
- +3 SET SCREEN="I $P(^TIU(8925.1,+Y,0),U,4)=""DOC"",($P(^(0),U)'[""ADDENDUM""),+$$ISA^TIULX(+Y,CLASS),+$$CANPICK^TIULP(+Y),+$$CANENTR^TIULP(+Y)"
- +4 SET TIUY=+$$ASKTYP^TIULA2(+CLASS,DFLT,SCREEN,"TITLE: ")
- +5 IF +$GET(TIUY)'>0
- SET TIUY=TIUTTL
- +6 QUIT TIUY
- RSLVTITL(TIUTTL) ; Resolve pointers to titles
- +1 QUIT $PIECE($GET(^TIU(8925.1,+TIUTTL,0)),U)
- ASKSEQ(TIUDFLT) ; Ask preferred sort sequence
- +1 NEW TIUPRMT,TIUSET,TIUY
- SET TIUDFLT=$GET(TIUDFLT,"D")
- +2 SET TIUPRMT="Please Specify Sort Order: "
- +3 SET TIUSET="A:ascending (OLDEST FIRST);D:descending (NEWEST FIRST)"
- +4 SET TIUY=$$READ^TIUU("SA^"_TIUSET,TIUPRMT,$SELECT(TIUDFLT="A":"ascending",1:"descending"))
- +5 QUIT TIUY
- DATENOTE(X) ; Ask for date/time of note
- +1 NEW %DT,Y
- +2 ;S TIUPRMT="DATE/TIME OF NOTE"
- +3 ;S TIUY=$$READ^TIUU("D^:NOW:RS",TIUPRMT,$G(DFLT,"NOW"),TIUHLP)
- +4 ;I +TIUY W " ",$P(TIUY,U,2)
- +5 SET %DT="RSX"
- SET %DT(0)="-NOW"
- DO ^%DT
- +6 IF +Y'>0
- Begin DoDot:1
- +7 WRITE !,$CHAR(7),"Enter DATE AND TIME of the note [TIME REQUIRED] (future dates prohibited)."
- End DoDot:1
- +8 QUIT +$GET(Y)
- SCRCSNR(TIUDA,Y) ; Evaluate whether a person may be selected to cosign
- +1 ; most people may be selected
- NEW TIUI,TIUY,TIUD0,TIUD12
- SET TIUY=1
- +2 SET TIUD0=$GET(^TIU(8925,+TIUDA,0))
- SET TIUD12=$GET(^TIU(8925,+TIUDA,12))
- +3 ; If he requires cosignature for this document a user may NOT select
- +4 ; himself
- +5 IF +$$REQCOSIG^TIULP(+TIUD0,+TIUDA,+$GET(DUZ))
- IF (Y=+$GET(DUZ))
- SET TIUY=0
- GOTO SCREENX
- +6 ; A TERMINATED User may NOT be selected
- +7 IF +$$ACTIVE^XUSER(+Y)'>0
- SET TIUY=0
- GOTO SCREENX
- +8 ; A non-PROVIDER may NOT be selected
- +9 IF +$$PROVIDER^TIUPXAP1(+Y,DT)'>0
- SET TIUY=0
- GOTO SCREENX
- +10 ; Author may NOT be selected
- +11 IF Y=+$PIECE(TIUD12,U,2)
- SET TIUY=0
- GOTO SCREENX
- +12 ; Expected Signer may NOT be selected
- +13 IF Y=+$PIECE(TIUD12,U,4)
- SET TIUY=0
- GOTO SCREENX
- +14 ; Others who require Cosignature may NOT be selected
- +15 IF +$$REQCOSIG^TIULP(+TIUD0,+TIUDA,+Y)
- SET TIUY=0
- SCREENX QUIT +$GET(TIUY)
- +1 ;
- SCRATT(TIUDA,PERSON) ; Can a person be an Attending for a given docmt?
- +1 NEW TIUD0,TIUTYP,CANSEL,DICTDT,TIUISDS,TIUPRNT,TIUPTYP,TIUPD0,TIUISAD
- +2 SET PERSON=+PERSON
- SET TIUDA=+TIUDA
- SET CANSEL=1
- +3 SET TIUD0=$GET(^TIU(8925,TIUDA,0))
- SET TIUPRNT=+$PIECE(TIUD0,U,6)
- +4 SET DICTDT=+$PIECE($GET(^TIU(8925,+TIUDA,13)),U,7)
- +5 IF DICTDT>0
- SET DICTDT=$PIECE(DICTDT,".")
- +6 ; Is Docmt an Addendum, a DS?
- +7 SET TIUTYP=+TIUD0
- SET (TIUPTYP,TIUISAD)=0
- +8 IF TIUPRNT>0
- SET TIUPTYP=+$GET(^TIU(8925,TIUPRNT,0))
- +9 IF TIUPTYP>0
- IF $PIECE($GET(^TIU(8925.1,TIUTYP,0)),U)["ADDENDUM"
- SET TIUISAD=1
- +10 SET TIUISDS=+$SELECT('TIUISAD:$$ISDS^TIULX(TIUTYP),1:$$ISDS^TIULX(TIUPTYP))
- +11 ; A TERMINATED (as of NOW) User may NOT be selected:
- +12 IF $$ISTERM^USRLM(PERSON)
- SET CANSEL=0
- GOTO SCRATTX
- +13 ; If not DS, is person an active provider?
- +14 IF 'TIUISDS
- if '$$PROVIDER^TIUPXAP1(PERSON,DT)
- SET CANSEL=0
- GOTO SCRATTX
- +15 ; TIUDA is a DS:
- +16 ; Attendings must be in USR Class PROVIDER NOW:
- +17 IF '$$ISA^USRLM(+PERSON,"PROVIDER")
- SET CANSEL=0
- GOTO SCRATTX
- +18 ; Persons who require Cosignature on Dictation Dt may NOT be selected:
- +19 IF +$$REQCOSIG^TIULP(TIUTYP,+TIUDA,PERSON,DICTDT)
- SET CANSEL=0
- SCRATTX QUIT +$GET(CANSEL)
- +1 ;
- SCRDFCS(USER,Y) ; Screen Default Cosigner selection for USER
- +1 NEW TIUY
- SET TIUY=1
- +2 SET USER=$GET(USER,DUZ)
- +3 ; A user may NOT select himself
- +4 IF Y=USER
- SET TIUY=0
- GOTO SCRDFX
- +5 ; A TERMINATED User may NOT be selected
- +6 IF +$$ACTIVE^XUSER(+Y)'>0
- SET TIUY=0
- GOTO SCREENX
- +7 ; A non-PROVIDER may NOT be selected
- +8 IF +$$PROVIDER^TIUPXAP1(+Y,DT)'>0
- SET TIUY=0
- GOTO SCREENX
- SCRDFX QUIT TIUY