| [613] | 1 | TIULA ; SLC/JER - Interactive Library functions ;9/29/03
|
|---|
| 2 | ;;1.0;TEXT INTEGRATION UTILITIES;**79,113**;Jun 20, 1997
|
|---|
| 3 | PATIENT(TIUSSN) ; Select a patient
|
|---|
| 4 | N X,DIC,Y S:$G(TIUSSN)]"" X=TIUSSN
|
|---|
| 5 | S DIC=2,DIC(0)=$S($G(TIUSSN)']"":"AEMQ",1:"MX") D ^DIC
|
|---|
| 6 | Q Y
|
|---|
| 7 | SELDIV ; Get document division(s)
|
|---|
| 8 | ;
|
|---|
| 9 | ; Output - SELDIV -1= user ^ at prompt if multidivisional
|
|---|
| 10 | ; 0= institution file pointer missing for
|
|---|
| 11 | ; division entry
|
|---|
| 12 | ; 1= successful division selection
|
|---|
| 13 | ; TIUDI( undefined= user <cr> for all divisions or ^ at prompt
|
|---|
| 14 | ; if multidivisional
|
|---|
| 15 | ; defined= user selected one or more divisions if
|
|---|
| 16 | ; multidivisional, or pre-selection of
|
|---|
| 17 | ; division file entry if not multidivisional;
|
|---|
| 18 | ; i.e.: TIUDI(file #40.8 ien)= Institution
|
|---|
| 19 | ; file pointer for file #40.8 entry
|
|---|
| 20 | N TIUI K SELDIV,TIUDI
|
|---|
| 21 | ; -- Determine if facility is multidivisional
|
|---|
| 22 | I $P($G(^DG(43,1,"GL")),U,2) D
|
|---|
| 23 | . D DIVISION^VAUTOMA
|
|---|
| 24 | . I Y<0 S SELDIV=-1 Q
|
|---|
| 25 | . I VAUTD=1 S SELDIV=1 Q
|
|---|
| 26 | . S TIUI=0 F S TIUI=$O(VAUTD(TIUI)) Q:'TIUI D ONE(TIUI)
|
|---|
| 27 | E D
|
|---|
| 28 | . S TIUI=$$PRIM^VASITE D ONE(TIUI)
|
|---|
| 29 | Q
|
|---|
| 30 | ONE(TIUI) ; Input - TIUI Medical Center Division file (#40.8) IEN
|
|---|
| 31 | N TIUIFP
|
|---|
| 32 | S TIUIFP=$P($$SITE^VASITE(,TIUI),U) I TIUIFP>0 D
|
|---|
| 33 | . S TIUDI(TIUI)=TIUIFP,SELDIV=1
|
|---|
| 34 | E D
|
|---|
| 35 | . S SELDIV=0
|
|---|
| 36 | Q
|
|---|
| 37 | ;
|
|---|
| 38 | SELSVC(TIUSVCS) ;Select Services
|
|---|
| 39 | ; Input -- None
|
|---|
| 40 | ; Output -- 1=Successful and 0=Failure
|
|---|
| 41 | ; TIUSVCS Service Selection Array
|
|---|
| 42 | N TIUCNT,TIUSVCI,Y
|
|---|
| 43 | S TIUCNT=0
|
|---|
| 44 | F Q:'$$ASKSVC(.TIUSVCS,TIUCNT,.TIUSVCI) D
|
|---|
| 45 | . S TIUSVCS(+TIUSVCI)=""
|
|---|
| 46 | . S TIUCNT=TIUCNT+1
|
|---|
| 47 | . S TIUSVCI=""
|
|---|
| 48 | I $G(TIUSVCI)=-1 S Y=0 G SELSVCQ
|
|---|
| 49 | I $G(TIUSVCI)="ALL" S TIUSVCS="ALL"
|
|---|
| 50 | S Y=1
|
|---|
| 51 | SELSVCQ Q +$G(Y)
|
|---|
| 52 | ;
|
|---|
| 53 | ASKSVC(TIUSVCS,TIUCNT,TIUSVCI) ;Ask Service
|
|---|
| 54 | ; Input -- TIUSVCS Service Selection Array
|
|---|
| 55 | ; TIUCNT Number of Services Selected
|
|---|
| 56 | ; Output -- 1=Successful and 0=Failure
|
|---|
| 57 | ; TIUSVCI Service/Section file (#49) IEN
|
|---|
| 58 | N DIR,DTOUT,DUOUT,X,Y
|
|---|
| 59 | S DIR(0)="PAO^49:AEMQ^K:'$$CHKSVC^TIULA(.TIUSVCS,+Y) X"
|
|---|
| 60 | S DIR("PRE")="I X="""",'$G(TIUCNT),'$D(DTOUT) S TIUSVCI=""ALL"""
|
|---|
| 61 | S DIR("A")="Select "_$S($G(TIUCNT):"another ",1:"")_"service: "_$S('$G(TIUCNT):"ALL// ",1:"")
|
|---|
| 62 | I '$G(TIUCNT) S DIR("?")=" OR enter Return for ALL services." W !
|
|---|
| 63 | D ^DIR
|
|---|
| 64 | I Y>0 S TIUSVCI=+Y
|
|---|
| 65 | I $D(DTOUT)!($D(DUOUT)) S TIUSVCI=-1
|
|---|
| 66 | Q $S($G(TIUSVCI)>0:1,1:0)
|
|---|
| 67 | ;
|
|---|
| 68 | CHKSVC(TIUSVCS,TIUSVCI) ;Check Selected Service
|
|---|
| 69 | ; Input -- TIUSVCS Service Selection Array
|
|---|
| 70 | ; TIUSVCI Service file (#49) IEN
|
|---|
| 71 | ; Output -- 1=Successful and 0=Failure
|
|---|
| 72 | N Y
|
|---|
| 73 | S Y=1
|
|---|
| 74 | ;Check if Service has already been selected
|
|---|
| 75 | I $D(TIUSVCS(TIUSVCI)) D EN^DDIOL("This Service has already been selected.","","!?5") S Y=0
|
|---|
| 76 | Q +$G(Y)
|
|---|
| 77 | ;
|
|---|
| 78 | SELSTAT(Y,PARM,DEF) ; Select Signature status
|
|---|
| 79 | N I,XQORM,X,TIUY
|
|---|
| 80 | S XQORM=+$O(^ORD(101,"B","TIU STATUS MENU",0))_";ORD(101,"
|
|---|
| 81 | I +XQORM'>0 W !,"Status selection unavailable." S TIUY=-1 G STATX
|
|---|
| 82 | S XQORM(0)=$G(PARM),XQORM("A")="Select Status: "
|
|---|
| 83 | I $S(PARM="F":1,PARM="R":1,1:0) S X=DEF
|
|---|
| 84 | S XQORM("B")=DEF D ^XQORM
|
|---|
| 85 | S TIUY=$G(Y)
|
|---|
| 86 | I +$G(Y)=1,(+$G(Y(1))=7) S Y=2,Y(2)="8^4843^amended^8"
|
|---|
| 87 | STATX Q TIUY
|
|---|
| 88 | SELSCRN(DEF) ; Select Review Screen
|
|---|
| 89 | N DIC,XQORM,X
|
|---|
| 90 | S DIC=101,DIC(0)="X",X="TIU REVIEW SCREEN MENU" D ^DIC
|
|---|
| 91 | I +Y>0 D
|
|---|
| 92 | . S XQORM=+Y_";ORD(101,",XQORM(0)="1A",XQORM("A")="Select Category: "
|
|---|
| 93 | . S XQORM("S")="I 1 X:$D(^ORD(101,+$P(^ORD(101,DA(1),10,DA,0),U),24)) ^(24)"
|
|---|
| 94 | . S XQORM("B")=DEF D ^XQORM
|
|---|
| 95 | . I +Y,($D(Y)>9) D
|
|---|
| 96 | . . S Y=$S(Y(1)["Author":"AAU",Y(1)["Patient":"APT",Y(1)["Spec":"ATS",Y(1)["Transcrip":"ATC",Y(1)["All":"ALL",Y(1)["Subject":"ASUB",Y(1)["Service":"ASVC",Y(1)["Location":"ALOC",1:"")
|
|---|
| 97 | . . I +$G(Y(1))'>0,(X'="^^"),(X'="^") D Q
|
|---|
| 98 | . . . W !,"^^-jumps not allowed from this prompt." S Y=-1
|
|---|
| 99 | . . S:Y'="ALL" Y=Y_U_$$SELPAR(Y)
|
|---|
| 100 | . . S:Y="ALL" Y=Y_U_"ANY"
|
|---|
| 101 | Q Y
|
|---|
| 102 | SELPAR(DEF) ; Select an author or patient or...
|
|---|
| 103 | N DIC,X,Y
|
|---|
| 104 | I DEF="ASUB" S Y=$$ASKSUBJ^TIULA1 G SELPARX
|
|---|
| 105 | S DIC=$S(DEF="APT":2,DEF="ATS":45.7,DEF="ASVC":123.5,1:200)
|
|---|
| 106 | S DIC(0)="AEMQ"
|
|---|
| 107 | S DIC("A")="Select "_$S(DEF="APT":"PATIENT",DEF="AAU":"AUTHOR",DEF="ATS":"TREATING SPECIALTY",DEF="ATC":"TRANSCRIPTIONIST",DEF="ASVC":"SERVICE",1:"ATTENDING PHYSICIAN")_": "
|
|---|
| 108 | I DEF="ARP" S DIC("S")="I $$ISA^USRLA(+$G(Y),""PROVIDER"")"
|
|---|
| 109 | D ^DIC K DIC("S") I +Y>0 D
|
|---|
| 110 | . I $S(DEF="APT"&'$D(^TIU(8925,"C",+Y)):1,DEF="AAU"&'$D(^TIU(8925,"CA",+Y)):1,DEF="ARP"&'$D(^TIU(8925,"CR",+Y)):1,1:0) W !,"No entries for ",$P(Y,U,2) S Y=0
|
|---|
| 111 | SELPARX Q Y
|
|---|
| 112 | EDATE(PRMPT,STATUS,DFLT) ; Get early date
|
|---|
| 113 | N X,Y,TIUPRMT,TIUDFLT
|
|---|
| 114 | I $G(STATUS)=4 S Y=1 Q Y
|
|---|
| 115 | S TIUPRMT=" Start "_$S($L($G(PRMPT)):PRMPT_" ",1:"")_"Date [Time]: "
|
|---|
| 116 | S TIUDFLT=$S($L($G(DFLT)):DFLT,1:"T-30")
|
|---|
| 117 | S Y=$$READ^TIUU("DOA^::AET",TIUPRMT,TIUDFLT)
|
|---|
| 118 | Q Y
|
|---|
| 119 | LDATE(PRMPT,STATUS,DFLT) ; Get late date
|
|---|
| 120 | N X,Y,TIUPRMT,TIUDFLT
|
|---|
| 121 | I $G(STATUS)=4 S Y=9999999 Q Y
|
|---|
| 122 | S TIUPRMT="Ending "_$S($L($G(PRMPT)):PRMPT_" ",1:"")_"Date [Time]: "
|
|---|
| 123 | S TIUDFLT=$S($L($G(DFLT)):DFLT,1:"NOW")
|
|---|
| 124 | S Y=$$READ^TIUU("DOA^::AET",TIUPRMT,TIUDFLT)
|
|---|
| 125 | Q Y
|
|---|
| 126 | CATEGORY() ; Select Service Category
|
|---|
| 127 | N DIR,X,Y
|
|---|
| 128 | S DIR(0)="9000010,.07",DIR("A")="Select SERVICE CATEGORY"
|
|---|
| 129 | D ^DIR
|
|---|
| 130 | Q Y_U_Y(0)
|
|---|
| 131 | SELTYP(DA,RETURN,PARM,DFLT,TYPE,MODE,DCLASS,PICK) ; Select Document Types
|
|---|
| 132 | N I,J,X,XQORM,CURTYP,Y
|
|---|
| 133 | I '$D(RETURN) S RETURN=$NA(^TMP("TIUTYP",$J)) K @RETURN
|
|---|
| 134 | ; TIUK is STATIC
|
|---|
| 135 | ;I +MODE D DOCLIST^TIULA1(DA,.RETURN,PARM,DFLT) Q:+RETURN'<0
|
|---|
| 136 | ; *** ADD CALL TO PERSONAL DOCUMENT LISTER HERE
|
|---|
| 137 | N:'$D(TIUK) TIUK S TIUK=+$G(TIUK)
|
|---|
| 138 | I $G(DFLT)="LAST" D
|
|---|
| 139 | . S DFLT=$O(^DISV(DUZ,"XQORM",DA_";TIU(8925.1,",0))
|
|---|
| 140 | . S DFLT=$S(+DFLT:$G(^DISV(DUZ,"XQORM",DA_";TIU(8925.1,",DFLT)),1:"")
|
|---|
| 141 | I $G(TYPE)']"" S TYPE="DOC"
|
|---|
| 142 | I $G(MODE)']"" S MODE=1 ; Default is ASK
|
|---|
| 143 | S XQORM=DA_";TIU(8925.1,",XQORM(0)=$S(+$P($G(^TIU(8925.1,+DA,10,0)),U,3)=1:"F",1:$G(PARM,"AD"))
|
|---|
| 144 | I XQORM(0)["D" S XQORM("H")="W !!,$$CENTER^TIULS(""--- ""_$P(^TIU(8925.1,+DA,0),U,3)_"" ---""),!"
|
|---|
| 145 | I $S(XQORM(0)="F":1,XQORM(0)="R":1,1:0) S X=$S(DFLT]"":DFLT,1:"ALL")
|
|---|
| 146 | S:$G(DFLT)]"" XQORM("B")=DFLT
|
|---|
| 147 | S XQORM("A")="Select "_$S(XQORM(0)["D":"Document",1:$P(^TIU(8925.1,+DA,0),U,3))_$S($P(^TIU(8925.1,+DA,0),U,4)="DOC":" Component",1:" Type")_$S(+XQORM(0)'=1:"(s)",1:"")_": "
|
|---|
| 148 | ; If screening inactive titles proves to be correct, remove comment
|
|---|
| 149 | ; from the line below:
|
|---|
| 150 | ; S XQORM("S")="I +$$CANPICK^TIULP(+$G(^TIU(8925.1,+DA(1),10,+DA,0)))>0"
|
|---|
| 151 | D EN^XQORM
|
|---|
| 152 | I +Y'>0,($D(@RETURN)'>9) S @RETURN=Y Q
|
|---|
| 153 | I (PARM["A"),(+$G(@RETURN)'>0) M PICK=Y
|
|---|
| 154 | S I=0 F S I=$O(Y(I)) Q:+I'>0 D
|
|---|
| 155 | . N TYPMATCH
|
|---|
| 156 | . S J=+$P(Y(I),U,2),CURTYP=$P($G(^TIU(8925.1,+J,0)),U,4)
|
|---|
| 157 | . I CURTYP="DC" S DCLASS=+$G(DCLASS)+1,DCLASS(DCLASS)=J
|
|---|
| 158 | . I I TYPE="DOC",(PARM["A"),(+$O(^TIU(8925.1,+J,10,0))'>0) W !!,"The Document Class ",$P(^TIU(8925.1,+J,0),U)," has no active titles at present..."
|
|---|
| 159 | . S TYPMATCH=$$TYPMATCH^TIULA1(TYPE,CURTYP)
|
|---|
| 160 | . I +TYPMATCH>0 D
|
|---|
| 161 | . . S TIUK=+$G(TIUK)+1,@RETURN@(TIUK)=Y(I),@RETURN=TIUK
|
|---|
| 162 | . I $S('+$G(TYPMATCH):1,CURTYP="CL":1,1:0),+$O(^TIU(8925.1,+J,10,0))>0 D SELTYP(+J,.RETURN,$S(MODE=1:$G(PARM),1:"F"),$S(MODE=1:"LAST",1:"ALL"),TYPE,MODE,.DCLASS,.PICK)
|
|---|
| 163 | Q
|
|---|
