- 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/TIUSRVR2.m
r613 r623 1 TIUSRVR2 ; SLC/JER - RPC for record-wise GET ; 11/23/072 ;;1.0;TEXT INTEGRATION UTILITIES;**100,109,162,222,234**;Jun 20, 1997;Build 6 3 4 LOADREC(TIUDA,TIUL,TIUGDATA,TIUGWHOL,ACTION) 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 LOADKIDS(TIUDA,TIUL,TIUGDATA,TIUGWHOL) 103 104 105 106 107 108 109 110 111 112 113 114 115 LOADID(TIUDA,TIUL,TIUGDATA,TIUWHOL) 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 INQUIRE(TIUDA,TIUREC,TIUCPF) 131 132 133 S DR=".01;.02;.05;.09;1201;1202;1208;1209;1301;1307;1501;1502;1505;1506;89261"134 135 136 137 138 139 LOADADD(TIUDADD,TIUL) 140 141 142 143 144 145 146 147 148 149 150 151 1 TIUSRVR2 ; SLC/JER - RPC for record-wise GET ; 4/14/03 2 ;;1.0;TEXT INTEGRATION UTILITIES;**100,109,162,222**;Jun 20, 1997 3 ; 4/12/01 Moved signature modules to new rtn TIUSRVR3 4 LOADREC(TIUDA,TIUL,TIUGDATA,TIUGWHOL,ACTION) ; Load ^TMP 5 ;Requires TIUDA, array TIUL, TIUGDATA 6 ;optional TIUGWHOL = 1 if we're mid-load for browse, and we're already 7 ; loading the whole note after the original entry, 8 ; so DON'T load the whole note again. 9 N TIUKID,TIUDADT,TIUI,CANSEE 10 N TIUPARNT,TIUPNAME,TIUPDATE 11 N TIUGPRNT,TIUGPNM,TIUGPDT,TIUPDATA,TIUHASKD 12 S ACTION=$G(ACTION,"VIEW") 13 ; ---- If user cannot view, say so and quit: ---- 14 ; TIU*1*100 15 S CANSEE=$S(+$$ISCOMP^TIUSRVR1(TIUDA)>0:1,1:$$CANDO^TIULP(+TIUDA,ACTION)) 16 I +CANSEE'>0 D Q 17 . S TIUL=TIUL+1,@TIUARR@(TIUL)=$P(CANSEE,U,2) 18 ; ---- Load text of TIUDA: ---- 19 S TIUI=0 20 F S TIUI=$O(^TIU(8925,+TIUDA,"TEXT",TIUI)) Q:+TIUI'>0 D 21 . S TIUL=TIUL+1,@TIUARR@(TIUL)=$G(^TIU(8925,+TIUDA,"TEXT",+TIUI,0)) 22 ; ---- if TIUDA is a COMPONENT, QUIT 23 Q:+$$ISCOMP^TIUSRVR1(TIUDA) 24 ; ---- If TIUDA **IS** an addendum, load addm signature, 25 ; load original document, quit: ---- 26 I +$$ISADDNDM^TIULC1(+TIUDA) D Q 27 . N TIULINE,TIUPARNT S $P(TIULINE,"=",79)="" 28 . D LOADSIG^TIUSRVR3(TIUDA,.TIUL) 29 . S TIUL=TIUL+1,@TIUARR@(TIUL)="" 30 . S TIUL=TIUL+1,@TIUARR@(TIUL)=TIULINE 31 . S TIUL=TIUL+1,@TIUARR@(TIUL)="" 32 . S TIUPARNT=+$P(^TIU(8925,+TIUDA,0),U,6) 33 . S TIUPNAME=$$PNAME^TIULC1(+^TIU(8925,TIUPARNT,0)) 34 . S TIUPDATE=+$G(^TIU(8925,TIUPARNT,13)) 35 . S TIUPDATE=$$DATE^TIULS(TIUPDATE,"MM/DD/YY") 36 . S TIUPDATA=$$IDDATA^TIURECL1(TIUPARNT) 37 . S TIUHASKD=$P(TIUPDATA,U,2),TIUGPRNT=+$P(TIUPDATA,U,3) 38 . S TIUL=+$G(TIUL)+1 39 . I TIUHASKD D 40 . . S @TIUARR@(TIUL)=" --- Original Addended Interdisciplinary Entry ---" 41 . I TIUGPRNT D 42 . . S @TIUARR@(TIUL)=" --- Original Addended Interdisciplinary Entry ---" 43 . . S TIUGPNM=$$PNAME^TIULC1(+^TIU(8925,TIUGPRNT,0)) 44 . . S TIUGPDT=+$G(^TIU(8925,TIUGPRNT,13)) 45 . . S TIUGPDT=$$DATE^TIULS(TIUGPDT,"MM/DD/YY") 46 . I 'TIUHASKD,'TIUGPRNT S @TIUARR@(TIUL)=" --- Original Document ---" 47 . S TIUL=+$G(TIUL)+1,@TIUARR@(TIUL)="" 48 . S TIUL=+$G(TIUL)+1 49 . I TIUHASKD D 50 . . S @TIUARR@(TIUL)=" << Addended Interdisciplinary Entry >>" 51 . . S TIUL=+$G(TIUL)+1 52 . . S @TIUARR@(TIUL)=TIUPDATE_" "_TIUPNAME_":" 53 . I TIUGPRNT D 54 . . S @TIUARR@(TIUL)=" << Interdisciplinary Note >>" 55 . . S TIUL=+$G(TIUL)+1 56 . . S @TIUARR@(TIUL)=TIUGPDT_" "_TIUGPNM 57 . . S TIUL=+$G(TIUL)+1 58 . . S @TIUARR@(TIUL)=" << Addended Interdisciplinary Entry >>" 59 . . S TIUL=+$G(TIUL)+1,@TIUARR@(TIUL)=TIUPDATE_" "_TIUPNAME_":" 60 . I 'TIUHASKD,'TIUGPRNT D 61 . . S @TIUARR@(TIUL)=TIUPDATE_" "_TIUPNAME_":" 62 . D LOADREC(TIUPARNT,.TIUL,TIUGDATA) 63 ; ---- Load components of TIUDA: ---- 64 S TIUKID=0 65 F S TIUKID=$O(^TIU(8925,"DAD",+TIUDA,TIUKID)) Q:+TIUKID'>0 D 66 . I +$$ISADDNDM^TIULC1(TIUKID)'>0 D LOADREC(TIUKID,.TIUL,$G(TIUGDATA)) 67 ; ---- Load signature of TIUDA if TIUDA is not addm 68 ; or comp: ---- 69 ; *222 don't display sig info. for FORM LETTERS 70 I '+$$MEMBEROF^TIUPR222(+$G(^TIU(8925,+TIUDA,0)),"FORM LETTERS") D 71 . I '$$ISCOMP^TIUSRVR1(TIUDA) D LOADSIG^TIUSRVR3(TIUDA,.TIUL) 72 ; ---- Load addenda of TIUDA: ---- 73 S TIUKID=0 74 F S TIUKID=$O(^TIU(8925,"DAD",+TIUDA,TIUKID)) Q:+TIUKID'>0 D 75 . ; If acting on an addendum, don't show it again. 76 . I +TIUKID=+$G(^TMP("TIU FOCUS",$J)) Q 77 . I +$$ISADDNDM^TIULC1(TIUKID) D LOADADD(TIUKID,.TIUL) 78 N IDDAD 79 S IDDAD=+$P(TIUGDATA,U,3) 80 ; ---- If Browsed Record is an ID Note, & this cycle has 81 ; just loaded the parent entry, then load ID kids 82 ; and quit: **100** ---- 83 I $P(TIUGDATA,U,2),TIUDA=+TIUGDATA D LOADKIDS(TIUDA,.TIUL,TIUGDATA) Q 84 ; ---- If Browsed Record is an ID Entry, & this cycle hasn't begun 85 ; loading the whole note, then load the whole ID Note after 86 ; the browsed entry and quit: ---- 87 I IDDAD,'$G(TIUGWHOL) D Q 88 . S TIUGWHOL=1 89 . N TIULINE S $P(TIULINE,"=",79)="" 90 . S TIUL=TIUL+1,@TIUARR@(TIUL)="" 91 . S TIUL=TIUL+1,@TIUARR@(TIUL)=TIULINE 92 . S TIUL=TIUL+1,@TIUARR@(TIUL)="" 93 . S TIUL=TIUL+1,@TIUARR@(TIUL)=" --- Interdisciplinary Note ---" 94 . S TIUL=TIUL+1,@TIUARR@(TIUL)="" 95 . D LOADID(IDDAD,.TIUL,TIUGDATA,TIUGWHOL) 96 ; ---- If Browsed Record is an ID Entry, & this cycle has begun 97 ; loading the whole ID note, and is currently loading the first 98 ; entry of the whole note, then load kids and quit: ---- 99 I IDDAD,$G(TIUGWHOL),TIUDA=IDDAD D LOADKIDS(TIUDA,.TIUL,TIUGDATA,TIUGWHOL) K TIUGWHOL 100 Q 101 ; 102 LOADKIDS(TIUDA,TIUL,TIUGDATA,TIUGWHOL) ; Load ID kids of TIUDA 103 ; Requires TIUDA, array TIUL, TIUGDATA 104 N TIUK,PRMSORT,KIDDA,TIUD0,TIUD21 105 I $G(^TMP("TIUR",$J,"IDDATA",TIUDA)) S PRMSORT=$P(^TMP("TIUR",$J,"IDDATA",TIUDA),U,4) 106 E S TIUD0=$G(^TIU(8925,TIUDA,0)),TIUD21=$G(^TIU(8925,TIUDA,21)),PRMSORT=$P($$IDDATA^TIURECL1(TIUDA,TIUD0,TIUD21),U,4) 107 D GETIDKID^TIURECL2(TIUDA,PRMSORT) ; sets array ^TMP("TIUIDKID",$J, 108 S TIUK=0 109 F S TIUK=$O(^TMP("TIUIDKID",$J,TIUDA,TIUK)) Q:+TIUK'>0 D 110 . S KIDDA=^TMP("TIUIDKID",$J,TIUDA,TIUK) 111 . D LOADID(KIDDA,.TIUL,TIUGDATA,$G(TIUGWHOL)) 112 K ^TMP("TIUIDKID",$J) 113 Q 114 ; 115 LOADID(TIUDA,TIUL,TIUGDATA,TIUWHOL) ; Load ID note for browse 116 N TIUREC,TIU 117 I '$D(^TIU(8925,+TIUDA,0)) Q 118 ; ---- If ID Kid has focus, don't show it again ---- 119 ; I TIUDA=+$G(^TMP("TIU FOCUS",$J)) Q 120 S TIUL=TIUL+1,@TIUARR@(TIUL)="" 121 D GETTIU^TIULD(.TIU,+TIUDA) 122 D INQUIRE(TIUDA,.TIUREC) 123 ; ---- Load info missing from header since this is ID note entry: ---- 124 ; ---- Load dictation, transcription data, etc.: ---- 125 D LOADTOP^TIUSRVR1(.TIUREC,TIUDA,.TIUL,$G(TIUGDATA)) 126 ; ---- Load the remainder of the record: ---- 127 D LOADREC(TIUDA,.TIUL,$G(TIUGDATA),$G(TIUWHOL)) 128 Q 129 ; 130 INQUIRE(TIUDA,TIUREC,TIUCPF) ; Inquire to document TIUDA and set TIUREC 131 N DA,DIC,DIQ,DR 132 S DA=TIUDA,DIC=8925,DIQ="TIUREC(" 133 S DR=".01;.02;.05;.09;1201;1202;1208;1209;1301;1307;1501;1502;1505;1506" 134 ;If the document is a member of the Clinical Procedures Class, include the 135 ;Procedure Summary Code field and the Date/Time Performed field 136 I $G(TIUCPF) S DR=DR_";70201;70202" 137 D EN^DIQ1 138 Q 139 LOADADD(TIUDADD,TIUL) ; Load addenda 140 N TIUDAUTH,TIUDATT,TIUJ,TIUSIG,TIUCSIG,TIUVIEW 141 S TIUL=TIUL+1,@TIUARR@(TIUL)="" 142 S TIUDADT=$$DATE^TIULS($P($G(^TIU(8925,+TIUDADD,13)),U),"MM/DD/CCYY") 143 S TIUL=TIUL+1,@TIUARR@(TIUL)=TIUDADT_" ADDENDUM"_" STATUS: "_$$STATUS^TIULF(TIUDADD) ;P162 144 S TIUVIEW=$$CANDO^TIULP(+TIUDADD,"VIEW") 145 I '+TIUVIEW D Q 146 . S TIUL=TIUL+1,@TIUARR@(TIUL)=$P(TIUVIEW,U,2) 147 S TIUJ=0 148 F S TIUJ=$O(^TIU(8925,+TIUDADD,"TEXT",TIUJ)) Q:+TIUJ'>0 D 149 . S TIUL=TIUL+1,@TIUARR@(TIUL)=$G(^TIU(8925,+TIUDADD,"TEXT",TIUJ,0)) 150 D LOADSIG^TIUSRVR3(TIUDADD,.TIUL) 151 Q
Note:
See TracChangeset
for help on using the changeset viewer.
