- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIULA3.m
r613 r623 1 TIULA3 ; SLC/JER - Still more interactive functions ;1/31/08 2 ;;1.0;TEXT INTEGRATION UTILITIES;**50,79,98,219**;Jun 20, 1997;Build 11 3 TITLE ; Title Look-up 4 N TIUI,TYPE,TIUCLASS S TIUI=0 5 S TIUTYP=$NA(^TMP("TIUTYP",$J)) 6 K @TIUTYP 7 I +$G(TIUPICT)'>0 Q 8 I $P($G(TIUPICT(1)),U,4)="ALL" D 9 . S TIUCLASS=+$O(^TIU(8925.1,"AD",+$P(TIUPICT(1),U,2),0)) 10 . K TIUPICT 11 . S TIUPICT=1,TIUPICT(1)="1^"_TIUCLASS_U_$$PNAME^TIULC1(TIUCLASS) 12 F S TIUI=$O(TIUPICT(TIUI)) Q:+TIUI'>0 D 13 . S TIUCLASS=$P(TIUPICT(TIUI),U,2) 14 . W !!,"For ",$$UP^XLFSTR($$PNAME^TIULC1(TIUCLASS)),": " 15 . D TITLPICK(.TYPE,TIUCLASS) 16 M @TIUTYP=TYPE 17 S Y="ANY" 18 Q 19 TITLPICK(TIUTYP,CLASS) ; Select multiple titles 20 N TIUI,TYPE,TIUPRMT S TIUI=0 21 W !!,"Please Select the ",$$UP^XLFSTR($$PNAME^TIULC1(CLASS)) 22 W " TITLES to search for:",! 23 F D Q:+$G(TYPE)'>0 24 . K TYPE 25 . S TIUI=TIUI+1,TIUPRMT=$J(TIUI,3)_") " 26 . D DOCSPICK^TIULA2(.TYPE,CLASS,"A",0,TIUPRMT) 27 . I +TYPE>0 S TIUTYP=+$G(TIUTYP)+1,TIUTYP(TIUTYP)=$G(TYPE(1)) 28 . I I $P(TYPE(1),U,4)="SINGLE ITEM" D 29 . . W !,"There is only one TITLE under ",$$UP^XLFSTR($$PNAME^TIULC1(CLASS)) 30 . . S TYPE=0 31 . I $S($D(DTOUT):1,$D(DUOUT):1,(+TYPE'>0&'$D(TIUTYP)):1,1:0) S TIUQUIT=1 32 W ! 33 Q 34 ASKTITLE(CLASS,TIUTTL) ; Ask for a different title, same class 35 N TIUY,TIUTYP,DFLT,SCREEN,X,Y 36 S DFLT=$$RSLVTITL(TIUTTL) 37 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)" 38 S TIUY=+$$ASKTYP^TIULA2(+CLASS,DFLT,SCREEN,"TITLE: ") 39 I +$G(TIUY)'>0 S TIUY=TIUTTL 40 Q TIUY 41 RSLVTITL(TIUTTL) ; Resolve pointers to titles 42 Q $P($G(^TIU(8925.1,+TIUTTL,0)),U) 43 ASKSEQ(TIUDFLT) ; Ask preferred sort sequence 44 N TIUPRMT,TIUSET,TIUY S TIUDFLT=$G(TIUDFLT,"D") 45 S TIUPRMT="Please Specify Sort Order: " 46 S TIUSET="A:ascending (OLDEST FIRST);D:descending (NEWEST FIRST)" 47 S TIUY=$$READ^TIUU("SA^"_TIUSET,TIUPRMT,$S(TIUDFLT="A":"ascending",1:"descending")) 48 Q TIUY 49 DATENOTE(X) ; Ask for date/time of note 50 N %DT,Y 51 ;S TIUPRMT="DATE/TIME OF NOTE" 52 ;S TIUY=$$READ^TIUU("D^:NOW:RS",TIUPRMT,$G(DFLT,"NOW"),TIUHLP) 53 ;I +TIUY W " ",$P(TIUY,U,2) 54 S %DT="RSX",%DT(0)="-NOW" D ^%DT 55 I +Y'>0 D 56 . W !,$C(7),"Enter DATE AND TIME of the note [TIME REQUIRED] (future dates prohibited)." 57 Q +$G(Y) 58 SCRCSNR(TIUDA,Y) ; Evaluate whether a person may be selected to cosign 59 N TIUI,TIUY,TIUD0,TIUD12 S TIUY=1 ; most people may be selected 60 S TIUD0=$G(^TIU(8925,+TIUDA,0)),TIUD12=$G(^TIU(8925,+TIUDA,12)) 61 ; If he requires cosignature for this document a user may NOT select 62 ; himself 63 I +$$REQCOSIG^TIULP(+TIUD0,+TIUDA,+$G(DUZ)),(Y=+$G(DUZ)) S TIUY=0 G SCREENX 64 ; A TERMINATED User may NOT be selected 65 I +$$ACTIVE^XUSER(+Y)'>0 S TIUY=0 G SCREENX 66 ; A non-PROVIDER may NOT be selected 67 I +$$PROVIDER^TIUPXAP1(+Y,DT)'>0 S TIUY=0 G SCREENX 68 ; Author may NOT be selected 69 I Y=+$P(TIUD12,U,2) S TIUY=0 G SCREENX 70 ; Expected Signer may NOT be selected 71 I Y=+$P(TIUD12,U,4) S TIUY=0 G SCREENX 72 ; Others who require Cosignature may NOT be selected 73 I +$$REQCOSIG^TIULP(+TIUD0,+TIUDA,+Y) S TIUY=0 74 SCREENX Q +$G(TIUY) 75 ; 76 SCRATT(TIUDA,PERSON) ; Can a person be an Attending for a given docmt? 77 N TIUD0,TIUTYP,CANSEL,DICTDT,TIUISDS,TIUPRNT,TIUPTYP,TIUPD0,TIUISAD 78 S PERSON=+PERSON,TIUDA=+TIUDA,CANSEL=1 79 S TIUD0=$G(^TIU(8925,TIUDA,0)),TIUPRNT=+$P(TIUD0,U,6) 80 S DICTDT=+$P($G(^TIU(8925,+TIUDA,13)),U,7) 81 I DICTDT>0 S DICTDT=$P(DICTDT,".") 82 ; Is Docmt an Addendum, a DS? 83 S TIUTYP=+TIUD0,(TIUPTYP,TIUISAD)=0 84 I TIUPRNT>0 S TIUPTYP=+$G(^TIU(8925,TIUPRNT,0)) 85 I TIUPTYP>0,$P($G(^TIU(8925.1,TIUTYP,0)),U)["ADDENDUM" S TIUISAD=1 86 S TIUISDS=+$S('TIUISAD:$$ISDS^TIULX(TIUTYP),1:$$ISDS^TIULX(TIUPTYP)) 87 ; A TERMINATED (as of NOW) User may NOT be selected: 88 I $$ISTERM^USRLM(PERSON) S CANSEL=0 G SCRATTX 89 ; If not DS, is person an active provider? 90 I 'TIUISDS S:'$$PROVIDER^TIUPXAP1(PERSON,DT) CANSEL=0 G SCRATTX 91 ; TIUDA is a DS: 92 ; Attendings must be in USR Class PROVIDER NOW: 93 I '$$ISA^USRLM(+PERSON,"PROVIDER") S CANSEL=0 G SCRATTX 94 ; Persons who require Cosignature on Dictation Dt may NOT be selected: 95 I +$$REQCOSIG^TIULP(TIUTYP,+TIUDA,PERSON,DICTDT) S CANSEL=0 96 SCRATTX Q +$G(CANSEL) 97 ; 98 SCRDFCS(USER,Y) ; Screen Default Cosigner selection for USER 99 N TIUY S TIUY=1 100 S USER=$G(USER,DUZ) 101 ; A user may NOT select himself 102 I Y=USER S TIUY=0 G SCRDFX 103 ; A TERMINATED User may NOT be selected 104 I +$$ACTIVE^XUSER(+Y)'>0 S TIUY=0 G SCREENX 105 ; A non-PROVIDER may NOT be selected 106 I +$$PROVIDER^TIUPXAP1(+Y,DT)'>0 S TIUY=0 G SCREENX 107 SCRDFX Q TIUY 1 TIULA3 ; SLC/JER - Still more interactive functions ;24-FEB-2000 12:22:04 2 ;;1.0;TEXT INTEGRATION UTILITIES;**50,79,98**;Jun 20, 1997 3 TITLE ; Title Look-up 4 N TIUI,TYPE,TIUCLASS S TIUI=0 5 S TIUTYP=$NA(^TMP("TIUTYP",$J)) 6 K @TIUTYP 7 I +$G(TIUPICT)'>0 Q 8 I $P($G(TIUPICT(1)),U,4)="ALL" D 9 . S TIUCLASS=+$O(^TIU(8925.1,"AD",+$P(TIUPICT(1),U,2),0)) 10 . K TIUPICT 11 . S TIUPICT=1,TIUPICT(1)="1^"_TIUCLASS_U_$$PNAME^TIULC1(TIUCLASS) 12 F S TIUI=$O(TIUPICT(TIUI)) Q:+TIUI'>0 D 13 . S TIUCLASS=$P(TIUPICT(TIUI),U,2) 14 . W !!,"For ",$$UP^XLFSTR($$PNAME^TIULC1(TIUCLASS)),": " 15 . D TITLPICK(.TYPE,TIUCLASS) 16 M @TIUTYP=TYPE 17 S Y="ANY" 18 Q 19 TITLPICK(TIUTYP,CLASS) ; Select multiple titles 20 N TIUI,TYPE,TIUPRMT S TIUI=0 21 W !!,"Please Select the ",$$UP^XLFSTR($$PNAME^TIULC1(CLASS)) 22 W " TITLES to search for:",! 23 F D Q:+$G(TYPE)'>0 24 . K TYPE 25 . S TIUI=TIUI+1,TIUPRMT=$J(TIUI,3)_") " 26 . D DOCSPICK^TIULA2(.TYPE,CLASS,"A",0,TIUPRMT) 27 . I +TYPE>0 S TIUTYP=+$G(TIUTYP)+1,TIUTYP(TIUTYP)=$G(TYPE(1)) 28 . I I $P(TYPE(1),U,4)="SINGLE ITEM" D 29 . . W !,"There is only one TITLE under ",$$UP^XLFSTR($$PNAME^TIULC1(CLASS)) 30 . . S TYPE=0 31 . I $S($D(DTOUT):1,$D(DUOUT):1,(+TYPE'>0&'$D(TIUTYP)):1,1:0) S TIUQUIT=1 32 W ! 33 Q 34 ASKTITLE(CLASS,TIUTTL) ; Ask for a different title, same class 35 N TIUY,TIUTYP,DFLT,SCREEN,X,Y 36 S DFLT=$$RSLVTITL(TIUTTL) 37 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)" 38 S TIUY=+$$ASKTYP^TIULA2(+CLASS,DFLT,SCREEN,"TITLE: ") 39 I +$G(TIUY)'>0 S TIUY=TIUTTL 40 Q TIUY 41 RSLVTITL(TIUTTL) ; Resolve pointers to titles 42 Q $P($G(^TIU(8925.1,+TIUTTL,0)),U) 43 ASKSEQ(TIUDFLT) ; Ask preferred sort sequence 44 N TIUPRMT,TIUSET,TIUY S TIUDFLT=$G(TIUDFLT,"D") 45 S TIUPRMT="Please Specify Sort Order: " 46 S TIUSET="A:ascending (OLDEST FIRST);D:descending (NEWEST FIRST)" 47 S TIUY=$$READ^TIUU("SA^"_TIUSET,TIUPRMT,$S(TIUDFLT="A":"ascending",1:"descending")) 48 Q TIUY 49 DATENOTE(X) ; Ask for date/time of note 50 N %DT,Y 51 ;S TIUPRMT="DATE/TIME OF NOTE" 52 ;S TIUY=$$READ^TIUU("D^:NOW:RS",TIUPRMT,$G(DFLT,"NOW"),TIUHLP) 53 ;I +TIUY W " ",$P(TIUY,U,2) 54 S %DT="RSX",%DT(0)="-NOW" D ^%DT 55 I +Y'>0 D 56 . W !,$C(7),"Enter DATE AND TIME of the note [TIME REQUIRED] (future dates prohibited)." 57 Q +$G(Y) 58 SCRCSNR(TIUDA,Y) ; Evaluate whether a person may be selected to cosign 59 N TIUI,TIUY,TIUD0,TIUD12 S TIUY=1 ; most people may be selected 60 S TIUD0=$G(^TIU(8925,+TIUDA,0)),TIUD12=$G(^TIU(8925,+TIUDA,12)) 61 ; If he requires cosignature for this document a user may NOT select 62 ; himself 63 I +$$REQCOSIG^TIULP(+TIUD0,+TIUDA,+$G(DUZ)),(Y=+$G(DUZ)) S TIUY=0 G SCREENX 64 ; A TERMINATED User may NOT be selected 65 I +$$ACTIVE^XUSER(+Y)'>0 S TIUY=0 G SCREENX 66 ; A non-PROVIDER may NOT be selected 67 I +$$PROVIDER^TIUPXAP1(+Y,DT)'>0 S TIUY=0 G SCREENX 68 ; Author may NOT be selected 69 I Y=+$P(TIUD12,U,2) S TIUY=0 G SCREENX 70 ; Expected Signer may NOT be selected 71 I Y=+$P(TIUD12,U,4) S TIUY=0 G SCREENX 72 ; Others who require Cosignature may NOT be selected 73 I +$$REQCOSIG^TIULP(+TIUD0,+TIUDA,+Y) S TIUY=0 74 SCREENX Q +$G(TIUY) 75 SCRDFCS(USER,Y) ; Screen Default Cosigner selection for USER 76 N TIUY S TIUY=1 77 S USER=$G(USER,DUZ) 78 ; A user may NOT select himself 79 I Y=USER S TIUY=0 G SCRDFX 80 ; A TERMINATED User may NOT be selected 81 I +$$ACTIVE^XUSER(+Y)'>0 S TIUY=0 G SCREENX 82 ; A non-PROVIDER may NOT be selected 83 I +$$PROVIDER^TIUPXAP1(+Y,DT)'>0 S TIUY=0 G SCREENX 84 SCRDFX Q TIUY
Note:
See TracChangeset
for help on using the changeset viewer.
