- 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/TIULX.m
r613 r623 1 TIULX ; SLC/JER - Cross-reference library functions ;6/21/06 2 ;;1.0;TEXT INTEGRATION UTILITIES;**1,28,79,100,136,219**;Jun 20, 1997;Build 11 3 ; File 200 - IA 10060 4 ; ^ORD(101 - IA 872 5 ; ^DISV - IA 510 6 ALOCP(DA) ; Should record be included in daily print queue by location? 7 ; Receives DA = record # in 8925 8 Q +$$ISPN(+$G(^TIU(8925,+DA,0))) 9 APTP(DA) ; Should record be included in daily print queue by patient? 10 ; Receives DA = record # in 8925 11 Q +$$ISPN(+$G(^TIU(8925,+DA,0))) 12 AAUP(DA) ; Should record be included in daily print queue by author? 13 ; Receives DA = record # in 8925 14 Q +$$ISPN(+$G(^TIU(8925,+DA,0))) 15 BELONGS(TIUDA,CLASS) ; Evaluate whether a given document belongs to a 16 ; particular document class 17 N TIUY 18 I +$$ISADDNDM^TIULC1(TIUDA) S TIUDA=+$P($G(^TIU(8925,+TIUDA,0)),U,6) 19 S TIUY=+$$ISA(+$G(^TIU(8925,+TIUDA,0)),CLASS) 20 Q TIUY 21 ISA(DA,CLASS) ; Evaluate whether a given document type is a member of a 22 ; particular document class 23 ; Receives DA = record # in 8925.1, and 24 ; CLASS = record # of class in 8925.1 25 N TIUI,TIUY S (TIUI,TIUY)=0 26 F S TIUI=$O(^TIU(8925.1,"AD",DA,TIUI)) Q:+TIUI'>0!(TIUY=1) D 27 . I TIUI=CLASS S TIUY=1 Q 28 . S TIUY=$$ISA(TIUI,CLASS) 29 Q TIUY 30 ISPN(DA) ; Evaluate whether a given document is a Progress Note 31 ; Receives DA = record # in 8925.1 32 N TIUI,TIUY S (TIUI,TIUY)=0 33 F S TIUI=$O(^TIU(8925.1,"AD",DA,TIUI)) Q:+TIUI'>0!(TIUY=1) D 34 . I TIUI=3 S TIUY=1 Q 35 . S TIUY=$$ISPN(TIUI) 36 Q TIUY 37 ISCWAD(DA) ; Evaluate whether a given title is a CWAD 38 ;Is the given title in a CWAD document class? 39 ;New for ID notes 40 ; Receives DA = record # in 8925.1 41 Q $S($$ISA(DA,25):1,$$ISA(DA,27):1,$$ISA(DA,30):1,$$ISA(DA,31):1,1:0) 42 ISDS(DA) ; Evaluate whether a given document is a Discharge Summary 43 ; Receives DA = record # in 8925.1 44 N TIUI,TIUY S (TIUI,TIUY)=0 45 F S TIUI=$O(^TIU(8925.1,"AD",DA,TIUI)) Q:+TIUI'>0!(TIUY=1) D 46 . I TIUI=244 S TIUY=1 Q 47 . S TIUY=$$ISDS(TIUI) 48 Q TIUY 49 TRNSFRM(RTYPE,FLD,X) ; Executes Transform code for a given header field 50 N XFORM 51 S FLD=$O(^TIU(8925.1,+RTYPE("TYPE"),"HEAD","D",+FLD,0)) 52 I +FLD'>0 G TRNSFRMX 53 S XFORM=$G(^TIU(8925.1,+RTYPE("TYPE"),"HEAD",+FLD,1)) 54 I XFORM']"" G TRNSFRMX 55 X XFORM 56 TRNSFRMX Q X 57 MENUS ; Evaluate/enforce user's menu display preference 58 N TIUI,TIUPREF S TIUPREF=$$PERSPRF^TIULE(DUZ),TIUI=0 59 F S TIUI=$O(^DISV(DUZ,"VALMMENU",TIUI)) Q:+TIUI'>0 D 60 . I $P($G(^ORD(101,+TIUI,0)),U)["TIU" S ^DISV(DUZ,"VALMMENU",TIUI)=$S($P(TIUPREF,U,5)=0:0,1:1) 61 Q 62 XTRASIGN(TIUY,TIUDA) ; Get list of extra signers for a document 63 N TIUI,TIUJ,TIUL,DA,DR,DIC,DIQ,TIUXTRA S (TIUI,TIUJ,TIUL)=0 64 S DIC="^TIU(8925.7,",DIQ="TIUXTRA" 65 F S TIUI=$O(^TIU(8925.7,"B",TIUDA,TIUI)) Q:+TIUI'>0 D 66 . N TIUX,TIUSGNR 67 . S DA=TIUI,DR=".03;.04" D EN^DIQ1 Q:+$D(TIUXTRA)'>9 68 . I $L($G(TIUXTRA(8925.7,DA,.04))) Q 69 . S TIUJ=+$G(TIUJ)+1,TIUL=+$G(TIUL)+1 70 . S TIUSGNR=$G(TIUXTRA(8925.7,DA,.03)) 71 . S TIUX=$$SETSTR^VALM1($G(TIUJ)_") "_TIUSGNR,$G(TIUX),1,39) 72 . S TIUY(TIUL)=DA_U_TIUX 73 Q 74 ASKSIGN(TIUY) ; Identify which Signature to edit 75 N I,L,Y 76 W !!,"Please Indicate Which Expected Signer to Change:",! 77 S (I,L,Y)=0 F S I=$O(TIUY(I)) Q:+I'>0!+Y D 78 . W:$P(TIUY(I),U)]"" !,$P(TIUY(I),U,2) 79 . I I#20=0 S Y=$P($$PICK(1,I,"Select Signer","NO"),U) 80 . S L=I 81 I L#20,'+Y S Y=$P($$PICK(1,L,"Select Signer","NO"),U) 82 I +Y,+$G(TIUY(+Y)) S Y=+$G(TIUY(+Y)) 83 Q Y 84 PICK(LOW,HIGH,PROMPT,TYPE) ; List selection 85 N X,Y S PROMPT=$G(PROMPT,"Select Item"),TYPE=$G(TYPE,"LO") 86 W ! 87 S Y=$$READ^TIUU(TYPE_U_LOW_":"_HIGH,PROMPT) 88 W ! 89 Q Y 90 CWAD ; Entry action for CWAD protocol 91 N GMRPALG,GMRPCWAD,GMRPDFN,GMRPOPT,GMRPEN,GMRPAGE,GMRPCWAD,GMRPDOB 92 N GMRPLOC,GMRPRB,GMRPSSN,GMRPQT 93 I $G(TIUGLINK) W !,"Please finish attaching the interdisciplinay note before displaying alerts.",! H 3 Q 94 D FULL^VALM1 95 I '+$G(DFN),'+$G(ORVP) D Q 96 . W !!,"No Patient Selected...",! 97 . I $$READ^TIUU("EA","Press RETURN to continue...") ; pause 98 . S VALMBCK="R" 99 D PAT^GMRPNOR1 I $D(GMRPQT) S VALMBCK="R" Q 100 S Y=GMRPDFN,GMRPOPT=1,GMRPEN=1 W !!,"** Current Patient: "_$P(Y,U,2) 101 D ENPAT^GMRPNCW S VALMBCK="R" 102 Q 103 IDSIGNRS(TIUY,TIUDA,TIULIST) ; Add list of Add'l Signers for a TIU Document 104 ; TIULIST(TIUI) [By Ref] = array of users to add/remove as signers 105 ; TIUDA = IEN in ^TIU(8925, 106 N TIUI S TIUI=0 107 F S TIUI=$O(TIULIST(TIUI)) Q:+TIUI'>0 D 108 . N DA,DIC,DLAYGO,DIE,DR,X,Y 109 . ; if current user is already an additional signer, and current user 110 . ; is NOT being removed as an additional signer, then QUIT 111 . I +$O(^TIU(8925.7,"AE",TIUDA,+TIULIST(TIUI),0)),($P(TIULIST(TIUI),U,3)'="REMOVE") Q 112 . ; if current user is being removed as a cosigner, then remove him 113 . I $P(TIULIST(TIUI),U,3)="REMOVE" D REMSIGNR(TIUDA,+TIULIST(TIUI)) Q 114 . ; otherwise, add the current user as an additional signer 115 . S X=""""_"`"_TIUDA_"""",(DIC,DLAYGO)=8925.7,DIC(0)="LX" D ^DIC Q:+Y'>0 116 . S DIE=DIC,TIUY=$G(TIUY)_$S($G(TIUY)]"":U,1:"")_+TIULIST(TIUI) 117 . S DR=".02////"_0_";.03////"_+$G(TIULIST(TIUI)) 118 . D ^DIE 119 . D SEND^TIUALRT(TIUDA) 120 Q 121 REMSIGNR(TIUDA,TIUDUZ) ; Remove user from additional signer list 122 N DA,DIE,DR,DIDEL 123 S DA=+$O(^TIU(8925.7,"AE",TIUDA,TIUDUZ,0)) Q:+DA'>0 124 S (DIDEL,DIE)=8925.7,DR=".01///@" D ^DIE 125 D SEND^TIUALRT(TIUDA) 126 Q 127 GETSIGNR(TIUY,TIUDA) ; RPC to Get list of extra signers for a document 128 N TIUI,DA,DR,DIC,DIQ,TIUXTRA,TIUD12,TIUAU,TIUEC S (DA,TIUI)=0 129 S DIC="^TIU(8925.7,",DIQ="TIUXTRA" 130 F S DA=$O(^TIU(8925.7,"B",TIUDA,DA)) Q:+DA'>0 D 131 . N TIUX,TIUSGNR 132 . S DR=".03;.04",DIQ(0)="IE" D EN^DIQ1 Q:+$D(TIUXTRA)'>9 133 . I +$G(TIUXTRA(8925.7,DA,.04,"I")) Q 134 . S TIUI=+$G(TIUI)+1 135 . S TIUY(TIUI)=$G(TIUXTRA(8925.7,DA,.03,"I"))_U_$G(TIUXTRA(8925.7,DA,.03,"E")) 136 S TIUD12=$G(^TIU(8925,TIUDA,12)) 137 S TIUAU=$P(TIUD12,U,4),TIUEC=$P(TIUD12,U,8) 138 S TIUI=+$G(TIUI)+1,TIUY(TIUI)=TIUAU_U_$$PERSNAME^TIULC1(TIUAU)_U_"AUTHOR" 139 I +TIUEC'>0 Q 140 I '$$FIND1^DIC(200,"","","`"_+TIUEC) D CLEAN^DILF Q 141 S TIUI=+$G(TIUI)+1,TIUY(TIUI)=TIUEC_U_$$PERSNAME^TIULC1(TIUEC)_U_"EXPECTED COSIGNER" 142 Q 143 HASDS(DFN,VSTR) ; Does an admission have a Discharge Summary? 144 N TITLE,TIUDA S (TIUDA,TITLE)=0 145 F S TITLE=$O(^TIU(8925,"APTLD",DFN,TITLE)) Q:+TITLE'>0 D Q:+TIUDA>0 146 . N STATUS,CONTEXT S TIUDA=0 147 . I '+$$ISDS(TITLE) S TIUDA=0_U_0 Q 148 . F S TIUDA=$O(^TIU(8925,"APTLD",DFN,TITLE,VSTR,+TIUDA)) Q:+TIUDA'>0 D Q:+$P(TIUDA,U,2) 149 . . S STATUS=+$P($G(^TIU(8925,+TIUDA,0)),U,5) 150 . . S CONTEXT=$S(STATUS=0:0,STATUS>13:0,STATUS'>5:2,1:1) 151 . . S TIUDA=TIUDA_U_CONTEXT 152 I '+TIUDA,($L(TIUDA,U)<2) S TIUDA=TIUDA_U_0 153 Q TIUDA 154 NEEDSIG(TIUY,USER,CLASS) ; Get list of documents for which USER is an additional signer 155 N TIUDA,TIUI,TIUJ S (TIUDA,TIUJ)=0 156 S USER=$G(USER,DUZ),CLASS=$G(CLASS,38),TIUY=$NA(^TMP("TIUSIGN",$J)) 157 K @TIUY ; Clear out return array before query 158 F S TIUDA=$O(^TIU(8925.7,"AES",USER,TIUDA)) Q:+TIUDA'>0 D 159 . S TIUI=0 F S TIUI=$O(^TIU(8925.7,"AES",USER,TIUDA,TIUI)) Q:+TIUI'>0 D 160 . . N TIUD0 S TIUD0=$G(^TIU(8925.7,TIUI,0)) Q:+$P(TIUD0,U,4) 161 . . Q:'+$$ISA(+$G(^TIU(8925,TIUDA,0)),CLASS) 162 . . S TIUJ=+$G(TIUJ)+1,@TIUY@(TIUJ)=TIUDA 163 Q 164 TITLIENS ; Get IENs of DDEF entries that have type Title 165 ; in Document Definition file 8925.1 166 ;Creates array ^TMP("TIUTLS,$J,TLIEN)= 167 ;Caller must kill ^TMP("TIUTLS",$J) when finished with the global. 168 N TIUIDX S TIUIDX=0 K ^TMP("TIUTLS",$J) 169 F S TIUIDX=$O(^TIU(8925.1,"AT","DOC",TIUIDX)) Q:TIUIDX'>0 D 170 . S ^TMP("TIUTLS",$J,TIUIDX)="" 171 Q 172 HASDOCMT(DFN) ;Does patient have ANY entries in TIU DOCUMENT file 8925? 173 ;Any entries includes original documents, addenda, components 174 ;(like S in SOAP notes), "deleted" documents, retracted documents, etc! 175 Q $O(^TIU(8925,"C",+$G(DFN),0))>0 176 1 TIULX ; SLC/JER - Cross-reference library functions ;18-JUN-2002 10:18:05 2 ;;1.0;TEXT INTEGRATION UTILITIES;**1,28,79,100,136**;Jun 20, 1997 3 ALOCP(DA) ; Should record be included in daily print queue by location? 4 ; Receives DA = record # in 8925 5 Q +$$ISPN(+$G(^TIU(8925,+DA,0))) 6 APTP(DA) ; Should record be included in daily print queue by patient? 7 ; Receives DA = record # in 8925 8 Q +$$ISPN(+$G(^TIU(8925,+DA,0))) 9 AAUP(DA) ; Should record be included in daily print queue by author? 10 ; Receives DA = record # in 8925 11 Q +$$ISPN(+$G(^TIU(8925,+DA,0))) 12 BELONGS(TIUDA,CLASS) ; Evaluate whether a given document belongs to a 13 ; particular document class 14 N TIUY 15 I +$$ISADDNDM^TIULC1(TIUDA) S TIUDA=+$P($G(^TIU(8925,+TIUDA,0)),U,6) 16 S TIUY=+$$ISA(+$G(^TIU(8925,+TIUDA,0)),CLASS) 17 Q TIUY 18 ISA(DA,CLASS) ; Evaluate whether a given document type is a member of a 19 ; particular document class 20 ; Receives DA = record # in 8925.1, and 21 ; CLASS = record # of class in 8925.1 22 N TIUI,TIUY S (TIUI,TIUY)=0 23 F S TIUI=$O(^TIU(8925.1,"AD",DA,TIUI)) Q:+TIUI'>0!(TIUY=1) D 24 . I TIUI=CLASS S TIUY=1 Q 25 . S TIUY=$$ISA(TIUI,CLASS) 26 Q TIUY 27 ISPN(DA) ; Evaluate whether a given document is a Progress Note 28 ; Receives DA = record # in 8925.1 29 N TIUI,TIUY S (TIUI,TIUY)=0 30 F S TIUI=$O(^TIU(8925.1,"AD",DA,TIUI)) Q:+TIUI'>0!(TIUY=1) D 31 . I TIUI=3 S TIUY=1 Q 32 . S TIUY=$$ISPN(TIUI) 33 Q TIUY 34 ISCWAD(DA) ; Evaluate whether a given title is a CWAD 35 ;Is the given title in a CWAD document class? 36 ;New for ID notes 37 ; Receives DA = record # in 8925.1 38 Q $S($$ISA(DA,25):1,$$ISA(DA,27):1,$$ISA(DA,30):1,$$ISA(DA,31):1,1:0) 39 ISDS(DA) ; Evaluate whether a given document is a Discharge Summary 40 ; Receives DA = record # in 8925.1 41 N TIUI,TIUY S (TIUI,TIUY)=0 42 F S TIUI=$O(^TIU(8925.1,"AD",DA,TIUI)) Q:+TIUI'>0!(TIUY=1) D 43 . I TIUI=244 S TIUY=1 Q 44 . S TIUY=$$ISDS(TIUI) 45 Q TIUY 46 TRNSFRM(RTYPE,FLD,X) ; Executes Transform code for a given header field 47 N XFORM 48 S FLD=$O(^TIU(8925.1,+RTYPE("TYPE"),"HEAD","D",+FLD,0)) 49 I +FLD'>0 G TRNSFRMX 50 S XFORM=$G(^TIU(8925.1,+RTYPE("TYPE"),"HEAD",+FLD,1)) 51 I XFORM']"" G TRNSFRMX 52 X XFORM 53 TRNSFRMX Q X 54 MENUS ; Evaluate/enforce user's menu display preference 55 N TIUI,TIUPREF S TIUPREF=$$PERSPRF^TIULE(DUZ),TIUI=0 56 F S TIUI=$O(^DISV(DUZ,"VALMMENU",TIUI)) Q:+TIUI'>0 D 57 . I $P($G(^ORD(101,+TIUI,0)),U)["TIU" S ^DISV(DUZ,"VALMMENU",TIUI)=$S($P(TIUPREF,U,5)=0:0,1:1) 58 Q 59 XTRASIGN(TIUY,TIUDA) ; Get list of extra signers for a document 60 N TIUI,TIUJ,TIUL,DA,DR,DIC,DIQ,TIUXTRA S (TIUI,TIUJ,TIUL)=0 61 S DIC="^TIU(8925.7,",DIQ="TIUXTRA" 62 F S TIUI=$O(^TIU(8925.7,"B",TIUDA,TIUI)) Q:+TIUI'>0 D 63 . N TIUX,TIUSGNR 64 . S DA=TIUI,DR=".03;.04" D EN^DIQ1 Q:+$D(TIUXTRA)'>9 65 . I $L($G(TIUXTRA(8925.7,DA,.04))) Q 66 . S TIUJ=+$G(TIUJ)+1,TIUL=+$G(TIUL)+1 67 . S TIUSGNR=$G(TIUXTRA(8925.7,DA,.03)) 68 . S TIUX=$$SETSTR^VALM1($G(TIUJ)_") "_TIUSGNR,$G(TIUX),1,39) 69 . S TIUY(TIUL)=DA_U_TIUX 70 Q 71 ASKSIGN(TIUY) ; Identify which Signature to edit 72 N I,L,Y 73 W !!,"Please Indicate Which Expected Signer to Change:",! 74 S (I,L,Y)=0 F S I=$O(TIUY(I)) Q:+I'>0!+Y D 75 . W:$P(TIUY(I),U)]"" !,$P(TIUY(I),U,2) 76 . I I#20=0 S Y=$P($$PICK(1,I,"Select Signer","NO"),U) 77 . S L=I 78 I L#20,'+Y S Y=$P($$PICK(1,L,"Select Signer","NO"),U) 79 I +Y,+$G(TIUY(+Y)) S Y=+$G(TIUY(+Y)) 80 Q Y 81 PICK(LOW,HIGH,PROMPT,TYPE) ; List selection 82 N X,Y S PROMPT=$G(PROMPT,"Select Item"),TYPE=$G(TYPE,"LO") 83 W ! 84 S Y=$$READ^TIUU(TYPE_U_LOW_":"_HIGH,PROMPT) 85 W ! 86 Q Y 87 CWAD ; Entry action for CWAD protocol 88 N GMRPALG,GMRPCWAD,GMRPDFN,GMRPOPT,GMRPEN,GMRPAGE,GMRPCWAD,GMRPDOB 89 N GMRPLOC,GMRPRB,GMRPSSN,GMRPQT 90 I $G(TIUGLINK) W !,"Please finish attaching the interdisciplinay note before displaying alerts.",! H 3 Q 91 D FULL^VALM1 92 I '+$G(DFN),'+$G(ORVP) D Q 93 . W !!,"No Patient Selected...",! 94 . I $$READ^TIUU("EA","Press RETURN to continue...") ; pause 95 . S VALMBCK="R" 96 D PAT^GMRPNOR1 I $D(GMRPQT) S VALMBCK="R" Q 97 S Y=GMRPDFN,GMRPOPT=1,GMRPEN=1 W !!,"** Current Patient: "_$P(Y,U,2) 98 D ENPAT^GMRPNCW S VALMBCK="R" 99 Q 100 IDSIGNRS(TIUY,TIUDA,TIULIST) ; Add list of Add'l Signers for a TIU Document 101 ; TIULIST(TIUI) [By Ref] = array of users to add/remove as signers 102 ; TIUDA = IEN in ^TIU(8925, 103 N TIUI S TIUI=0 104 F S TIUI=$O(TIULIST(TIUI)) Q:+TIUI'>0 D 105 . N DA,DIC,DLAYGO,DIE,DR,X,Y 106 . ; if current user is already an additional signer, and current user 107 . ; is NOT being removed as an additional signer, then QUIT 108 . I +$O(^TIU(8925.7,"AE",TIUDA,+TIULIST(TIUI),0)),($P(TIULIST(TIUI),U,3)'="REMOVE") Q 109 . ; if current user is being removed as a cosigner, then remove him 110 . I $P(TIULIST(TIUI),U,3)="REMOVE" D REMSIGNR(TIUDA,+TIULIST(TIUI)) Q 111 . ; otherwise, add the current user as an additional signer 112 . S X=""""_"`"_TIUDA_"""",(DIC,DLAYGO)=8925.7,DIC(0)="LX" D ^DIC Q:+Y'>0 113 . S DIE=DIC,TIUY=$G(TIUY)_$S($G(TIUY)]"":U,1:"")_+TIULIST(TIUI) 114 . S DR=".02////"_0_";.03////"_+$G(TIULIST(TIUI)) 115 . D ^DIE 116 . D SEND^TIUALRT(TIUDA) 117 Q 118 REMSIGNR(TIUDA,TIUDUZ) ; Remove user from additional signer list 119 N DA,DIE,DR,DIDEL 120 S DA=+$O(^TIU(8925.7,"AE",TIUDA,TIUDUZ,0)) Q:+DA'>0 121 S (DIDEL,DIE)=8925.7,DR=".01///@" D ^DIE 122 D SEND^TIUALRT(TIUDA) 123 Q 124 GETSIGNR(TIUY,TIUDA) ; RPC to Get list of extra signers for a document 125 N TIUI,DA,DR,DIC,DIQ,TIUXTRA,TIUD12,TIUAU,TIUEC S (DA,TIUI)=0 126 S DIC="^TIU(8925.7,",DIQ="TIUXTRA" 127 F S DA=$O(^TIU(8925.7,"B",TIUDA,DA)) Q:+DA'>0 D 128 . N TIUX,TIUSGNR 129 . S DR=".03;.04",DIQ(0)="IE" D EN^DIQ1 Q:+$D(TIUXTRA)'>9 130 . I +$G(TIUXTRA(8925.7,DA,.04,"I")) Q 131 . S TIUI=+$G(TIUI)+1 132 . S TIUY(TIUI)=$G(TIUXTRA(8925.7,DA,.03,"I"))_U_$G(TIUXTRA(8925.7,DA,.03,"E")) 133 S TIUD12=$G(^TIU(8925,TIUDA,12)) 134 S TIUAU=$P(TIUD12,U,4),TIUEC=$P(TIUD12,U,8) 135 S TIUI=+$G(TIUI)+1,TIUY(TIUI)=TIUAU_U_$$PERSNAME^TIULC1(TIUAU)_U_"AUTHOR" 136 I $S(+TIUEC'>0:1,'$L($G(^VA(200,+TIUEC,0))):1,1:0) Q 137 S TIUI=+$G(TIUI)+1,TIUY(TIUI)=TIUEC_U_$$PERSNAME^TIULC1(TIUEC)_U_"EXPECTED COSIGNER" 138 Q 139 HASDS(DFN,VSTR) ; Does an admission have a Discharge Summary? 140 N TITLE,TIUDA S (TIUDA,TITLE)=0 141 F S TITLE=$O(^TIU(8925,"APTLD",DFN,TITLE)) Q:+TITLE'>0 D Q:+TIUDA>0 142 . N STATUS,CONTEXT S TIUDA=0 143 . I '+$$ISDS(TITLE) S TIUDA=0_U_0 Q 144 . F S TIUDA=$O(^TIU(8925,"APTLD",DFN,TITLE,VSTR,+TIUDA)) Q:+TIUDA'>0 D Q:+$P(TIUDA,U,2) 145 . . S STATUS=+$P($G(^TIU(8925,+TIUDA,0)),U,5) 146 . . S CONTEXT=$S(STATUS=0:0,STATUS>13:0,STATUS'>5:2,1:1) 147 . . S TIUDA=TIUDA_U_CONTEXT 148 I '+TIUDA,($L(TIUDA,U)<2) S TIUDA=TIUDA_U_0 149 Q TIUDA 150 NEEDSIG(TIUY,USER,CLASS) ; Get list of documents for which USER is an additional signer 151 N TIUDA,TIUI,TIUJ S (TIUDA,TIUJ)=0 152 S USER=$G(USER,DUZ),CLASS=$G(CLASS,38),TIUY=$NA(^TMP("TIUSIGN",$J)) 153 K @TIUY ; Clear out return array before query 154 F S TIUDA=$O(^TIU(8925.7,"AES",USER,TIUDA)) Q:+TIUDA'>0 D 155 . S TIUI=0 F S TIUI=$O(^TIU(8925.7,"AES",USER,TIUDA,TIUI)) Q:+TIUI'>0 D 156 . . N TIUD0 S TIUD0=$G(^TIU(8925.7,TIUI,0)) Q:+$P(TIUD0,U,4) 157 . . Q:'+$$ISA(+$G(^TIU(8925,TIUDA,0)),CLASS) 158 . . S TIUJ=+$G(TIUJ)+1,@TIUY@(TIUJ)=TIUDA 159 Q 160
Note:
See TracChangeset
for help on using the changeset viewer.
