- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAHLO4.m
r613 r623 1 RAHLO4 ;HIRMFO/GJC-File rpt (data from bridge program) ;7/21/99 11:45 2 ;;5.0;Radiology/Nuclear Medicine;**4,8,81,84**;Mar 16, 1998;Build 13 3 ; 4 ;Integration Agreements 5 ;---------------------- 6 ;NOW^%DTC(10000); %ZTLOAD(10063); FIND^DIC(2051); ^DIE(10018); ^DIK(10013); $$GET1^DIQ(2056) 7 ;GETS^DIQ(2056); ^XMD(10070) 8 ; 9 TASK ; Task ORU message 10 S ZTDESC="Rad/Nuc Med Compiling HL7 ORU Message",ZTDTH=$H,ZTIO="",ZTRTN="RPT^RAHLRPC",ZTSAVE("RADFN")="",ZTSAVE("RADTI")="",ZTSAVE("RACNI")="",ZTSAVE("RARPT")="" 11 ;Next line of coding will assure that ORU (report) message will be sent after posible ORM message. (10 second) 12 S $P(ZTDTH,",",2)=$P(ZTDTH,",",2)+4 S:$P(ZTDTH,",",2)>86400 ZTDTH=$P(ZTDTH,",")+1_","_($P(ZTDTH,",",2)-86400) 13 S:$L($G(RANOSEND)) ZTSAVE("RANOSEND")="" D ^%ZTLOAD 14 K ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE 15 Q 16 VOICE ; voice dictation auto-print (background process) 17 Q:$P(^RA(79.1,+$G(RAMLC),0),U,26)'="Y" ; Voice Dictation Auto-Print 18 S ZTIO=$$GET1^DIQ(3.5,+$P(^RA(79.1,+$G(RAMLC),0),U,10),.01) ; dev name 19 Q:ZTIO']"" ; quit if the device does not exist 20 S ZTDTH=$H,ZTRTN="DQ^RARTR",ZTSAVE("RARPT")="" 21 S ZTDESC="Rad/Nuc Med voice dictation auto-print" 22 D ^%ZTLOAD K RAMES,ZTDESC,ZTSK,ZTIO,ZTSAVE,ZTRTN,RASV,ZTDTH 23 Q 24 ; 25 UPMEM ;copy (prim:dx,stf,res),rpt ien to other members of same print set 26 ; first clear those fields 27 K DIE,DA,DR S DA=RACNI,DA(1)=RADTI,DA(2)=RADFN 28 S DIE="^RADPT("_DA(2)_",""DT"","_DA(1)_",""P""," 29 S DR="13///@;12///@;15///@" D ^DIE 30 ; now set those fields based on lead case of printset 31 S DR="13////"_RA13_";12////"_RA12_";15////"_RA15 D ^DIE K DA,DR,DIE 32 ; now set the report pointer (uneditable, thus must hard set) 33 S $P(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),"^",17)=RARPT 34 Q 35 SETPHYS ;set Primary Resident or Staff, either piece 12 or piece 15 of case 36 Q:RADPIECE'=15&(RADPIECE'=12) 37 S DR=RADPIECE_"////"_$G(RAVERF) 38 S DA(2)=RADFN,DA(1)=RADTI,DA=RACNI 39 S DIE="^RADPT("_DA(2)_",""DT"","_DA(1)_",""P""," 40 D ^DIE K DA,DR 41 Q 42 KILSECDG ;kill secondary diagnoses nodes of this case 43 Q:'$D(RADFN)!('$D(RADTI))!('$D(RACNI)) 44 Q:RADFN=""!(RADTI="")!(RACNI="") 45 Q:'$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"DX",0)) 46 S DA(3)=RADFN,DA(2)=RADTI,DA(1)=RACNI 47 N RA1 S RA1="" 48 K1 S RA1=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"DX",RA1)) G:RA1="" KQ 49 S DA=RA1 50 S DIK="^RADPT("_DA(3)_",""DT"","_DA(2)_",""P"","_DA(1)_",""DX""," 51 D ^DIK 52 G K1 53 KQ K DA Q 54 ; 55 PCEXTR(RASUB,RASEG,RAPCE,RADEL) ; extract the right piece of data 56 ; from the right data node 57 ; input: RASUB-data node subscript 58 ; RASEG-HL7 segment (minus the segment header) 59 ; RAPCE-data's piece position 60 ; RADEL-delimiter (field separator) 61 S RAHL70="",RAHL7X=0,RAHL7OFF=$L(RASEG,RADEL) 62 S RAHL7LST=$P(RASEG,RADEL,RAHL7OFF) 63 I RAPCE<RAHL7OFF S RAHL70=$P(RASEG,RADEL,RAPCE) D KILL Q RAHL70 64 I RAHL7OFF=RAPCE D ; check if data wraps to the next node (if any) 65 . S RAHL70=$P(RASEG,RADEL,RAPCE),II1=$O(^TMP("RARPT-HL7",$J,RASUB,0)) 66 . S:'II1 RAHL7X=1 Q:'II1 67 . S RAHL70=RAHL70_$P(^TMP("RARPT-HL7",$J,RASUB,II1),RADEL),RAHL7X=1 68 . Q 69 I RAHL7X D KILL Q RAHL70 70 ; check if this node has descendent data nodes 71 I '$O(^TMP("RARPT-HL7",$J,RASUB,0)) D KILL Q "" ; descendents not found 72 S I=0,RAHL7CNT=RAHL7OFF 73 F S I=$O(^TMP("RARPT-HL7",$J,RASUB,I)) Q:I'>0 D Q:RAHL7X 74 . S RAHL7SUB=$G(^TMP("RARPT-HL7",$J,RASUB,I)) 75 . S RAHL7PRE=$O(^TMP("RARPT-HL7",$J,RASUB,I),-1) 76 . S:RAHL7PRE RAHL7LST=$$LSTPCE(^TMP("RARPT-HL7",$J,RASUB,RAHL7PRE),RADEL) 77 . F II1=1:1:$L(RAHL7SUB,RADEL) D Q:RAHL7X 78 .. ; HL7 may have broken the string on data! 79 .. I II1=1 S RAHL7ARY(RAHL7CNT)=RAHL7LST_$P(RAHL7SUB,RADEL) 80 .. E D ; for the case II1'=1 81 ... S RAHL7CNT=RAHL7CNT+1 82 ... S RAHL7ARY(RAHL7CNT)=$P(RAHL7SUB,RADEL,II1) 83 ... Q 84 .. I RAHL7CNT=RAPCE,(II1'=$L(RAHL7SUB,RADEL)) S RAHL7X=1,RAHL70=RAHL7ARY(RAHL7CNT) 85 .. I RAHL7CNT=RAPCE,(II1=$L(RAHL7SUB,RADEL)) D 86 ... ; grab the 1st piece of the next node (if any) 87 ... S RAHL7X=1,RAHL70=RAHL7ARY(RAHL7CNT) 88 ... S N1=+$O(^TMP("RARPT-HL7",$J,RASUB,I)) Q:'N1 89 ... S RAHL70=RAHL70_$P(^TMP("RARPT-HL7",$J,RASUB,N1),RADEL) 90 ... Q 91 .. K:'RAHL7X RAHL7ARY 92 .. Q 93 . Q 94 D KILL 95 Q RAHL70 96 KILL ; kill the RAHLD* variables 97 K I,II1,N1,RAHL7ARY,RAHL7CNT,RAHL7LST,RAHL7OFF,RAHL7PRE,RAHL7SUB,RAHL7X 98 Q 99 LSTPCE(X,DEL) ; given a string and a delimiter, return the last piece 100 Q $P(X,DEL,$L(X,DEL)) 101 CKDUPA ; if duplicate addendum, send msg to members of unverify rpt mailgroup 102 S RADUPA=0 ; 0 means not a duplicate 103 N I1,I2,X1,X2,X3,X4,X21,R0,R1,R2,MATCH,XMSUB 104 S I1="I",I2="RAIMP" I $O(^RARPT(RARPT,I1,0))'="" D ISITDUP ;Q:'RADUPA 105 ; 106 I 'RADUPA S I1="R",I2="RATXT" I $O(^RARPT(RARPT,I1,0))'="" D ISITDUP Q:'RADUPA 107 ;S I1="R",I2="RATXT" I $O(^RARPT(RARPT,I1,0))'="" D ISITDUP Q:'RADUPA 108 ; 109 S XMSUB="Duplicate addendum being sent to Vista" 110 ; 111 ; check to see if mail message already sent for 112 ; this case no. TODAY only. if so quit - no need to 113 ; re-send to save time backwards $ORDER, duplicate 114 ; most likely to be most recently. 115 S (XMB,XMATCH)="" 116 D NOW^%DTC S RATDY=X K X 117 F S XMB=$O(^XMB(3.9,"B",$E(XMSUB,1,30),XMB),-1) Q:XMB="" D Q:XMATCH'="" 118 .I $P($$GET1^DIQ(3.9,XMB,1.4,"I"),".")'=RATDY S XMATCH=0 Q ;(DBIA2860) 119 .Q:$G(^XMB(3.9,XMB,2,6,0))'[RALONGCN 120 .S XMATCH=1 121 K XMB,RATDY 122 Q:XMATCH=1 123 ; 124 ; send mail to members of unverify bulletin (DBIA2861) 125 ; find ien of unverify bulletin 126 D FIND^DIC(3.6,"","","","RAD/NUC MED REPORT UNVERIFIED",1,"","","","R0") 127 Q:'$D(R0("DILIST",2,1))#2 128 ; find name of mail group linked to that bulletin 129 D GETS^DIQ(3.6,R0("DILIST",2,1),"4*","EI","R1") 130 ; check to see if MailGroup is PUBLIC, otherwise quit 131 S X=$G(R1(3.62,"1,"_R0("DILIST",2,1)_",",.01,"I")) I X="" K X Q 132 I $$GET1^DIQ(3.8,X_",",4,"I")'="PU" K X Q 133 S X=$G(R1(3.62,"1,"_R0("DILIST",2,1)_",",.01,"E")) I X="" K X Q 134 N XMDUZ,XMTEXT,XMY,MSGTXT,XRAVERF,XRATRANS,XRADFN 135 S X="G."_X,XMY(X)="" K X ;recipient mail group 136 ; 137 S XMDUZ=.5 138 S MSGTXT(1)=$G(^TMP("RARPT-REC",$J,RASUB,"VENDOR"))_" is sending duplicate addenda to Radiology/Nuclear Medicine." 139 S MSGTXT(2)=" " 140 S MSGTXT(3)="The following radiology report was sent with a duplicate addendum:" 141 S:RADFN'="" XRADFN=$$GET1^DIQ(2,RADFN,.01) 142 S:$G(XRADFN)="" XRADFN="Unknown" 143 S MSGTXT(4)=" 1) Patient : "_XRADFN 144 S MSGTXT(5)=" 2) SSN : "_$$SSN^RAUTL() 145 S MSGTXT(6)=" 3) Case Number : "_RALONGCN 146 S:RAVERF'="" XRAVERF=$$GET1^DIQ(200,RAVERF,.01) 147 S:$G(XRAVERF)="" XRAVERF="Unknown" 148 S MSGTXT(7)=" 4) Verifier : "_XRAVERF 149 S:RATRANSC'="" XRATRANS=$$GET1^DIQ(200,RATRANSC,.01) 150 S:$G(XRATRANS)="" XRATRANS="Unknown" 151 S MSGTXT(8)=" 5) Transcriptionist : "_XRATRANS 152 S MSGTXT(9)=" " 153 S MSGTXT(10)="Please notify IRM." 154 S XMTEXT="MSGTXT(" 155 D ^XMD 156 Q 157 ISITDUP ; X1=last ien ^RARPT, X2=LAST IEN ^TMP, x21=first ien ^TMP 158 Q:'$O(^TMP("RARPT-REC",$J,RASUB,I2,0)) 159 N X1,X2,X21,X3,X4,XX 160 S RADUPA=0 ; Reset to zero otherwise Imp Text match will override 161 S X1=$O(^RARPT(RARPT,I1,""),-1) 162 S XX=$G(^RARPT(RARPT,I1,X1,0)) S XX=$S(XX=""!(XX=" "):0,1:1) 163 S X2=$O(^TMP("RARPT-REC",$J,RASUB,I2,""),-1),X21=$O(^(0)) 164 S X3=X1-X2+XX Q:X3<1 ; begin comparison from ^RARPT(RARPT,I1,X3 165 ; chk 1st line of previous addendum 166 Q:^RARPT(RARPT,I1,X3,0)'["Addendum: " S X4=^(0) 167 S X4=$E(X4,$L("Addendum: ")+1,$L(X4)) ; exclude "Addendum: " from X4 168 Q:X4'=^TMP("RARPT-REC",$J,RASUB,I2,X21) 169 ; chk remaining lines 170 S X21=X21+1 F X1=X21:1:X2 S X3=X3+1 Q:^RARPT(RARPT,I1,X3,0)'=^TMP("RARPT-REC",$J,RASUB,I2,X1) 171 Q:X1<X2 172 S RADUPA=1 173 Q 1 RAHLO4 ;HIRMFO/GJC-File rpt (data from bridge program) ;7/21/99 11:45 2 ;;5.0;Radiology/Nuclear Medicine;**4,8,81**;Mar 16, 1998;Build 12 3 TASK ; Task ORU message 4 S ZTDESC="Rad/Nuc Med Compiling HL7 ORU Message",ZTDTH=$H,ZTIO="",ZTRTN="RPT^RAHLRPC",ZTSAVE("RADFN")="",ZTSAVE("RADTI")="",ZTSAVE("RACNI")="",ZTSAVE("RARPT")="" 5 ;S:$L($G(RANOSEND))&'$O(RAPRSET(RADTI,0)) ZTSAVE("RANOSEND")="" D ^%ZTLOAD 6 S:$L($G(RANOSEND)) ZTSAVE("RANOSEND")="" D ^%ZTLOAD 7 K ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE 8 Q 9 VOICE ; voice dictation auto-print (background process) 10 Q:$P(^RA(79.1,+$G(RAMLC),0),U,26)'="Y" ; Voice Dictation Auto-Print 11 S ZTIO=$$GET1^DIQ(3.5,+$P(^RA(79.1,+$G(RAMLC),0),U,10),.01) ; dev name 12 Q:ZTIO']"" ; quit if the device does not exist 13 S ZTDTH=$H,ZTRTN="DQ^RARTR",ZTSAVE("RARPT")="" 14 S ZTDESC="Rad/Nuc Med voice dictation auto-print" 15 D ^%ZTLOAD K RAMES,ZTDESC,ZTSK,ZTIO,ZTSAVE,ZTRTN,RASV,ZTDTH 16 Q 17 FILETST ; is anyone else working on this report? 18 L +^RARPT(RARPT):1 19 I '$T S RAERR="This report is being edited by another user" L -^RARPT(RARPT) 20 Q 21 UPMEM ;copy (prim:dx,stf,res),rpt ien to other members of same print set 22 ; first clear those fields 23 K DIE,DA,DR S DA=RACNI,DA(1)=RADTI,DA(2)=RADFN 24 S DIE="^RADPT("_DA(2)_",""DT"","_DA(1)_",""P""," 25 S DR="13///@;12///@;15///@" D ^DIE 26 ; now set those fields based on lead case of printset 27 S DR="13////"_RA13_";12////"_RA12_";15////"_RA15 D ^DIE K DA,DR,DIE 28 ; now set the report pointer (uneditable, thus must hard set) 29 S $P(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),"^",17)=RARPT 30 Q 31 SETPHYS ;set Primary Resident or Staff, either piece 12 or piece 15 of case 32 Q:RADPIECE'=15&(RADPIECE'=12) 33 S DR=RADPIECE_"////"_$G(RAVERF) 34 S DA(2)=RADFN,DA(1)=RADTI,DA=RACNI 35 S DIE="^RADPT("_DA(2)_",""DT"","_DA(1)_",""P""," 36 D ^DIE K DA,DR 37 Q 38 KILSECDG ;kill secondary diagnoses nodes of this case 39 Q:'$D(RADFN)!('$D(RADTI))!('$D(RACNI)) 40 Q:RADFN=""!(RADTI="")!(RACNI="") 41 Q:'$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"DX",0)) 42 S DA(3)=RADFN,DA(2)=RADTI,DA(1)=RACNI 43 N RA1 S RA1="" 44 K1 S RA1=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"DX",RA1)) G:RA1="" KQ 45 S DA=RA1 46 S DIK="^RADPT("_DA(3)_",""DT"","_DA(2)_",""P"","_DA(1)_",""DX""," 47 D ^DIK 48 G K1 49 KQ K DA Q 50 ; 51 PCEXTR(RASUB,RASEG,RAPCE,RADEL) ; extract the right piece of data 52 ; from the right data node 53 ; input: RASUB-data node subscript 54 ; RASEG-HL7 segment (minus the segment header) 55 ; RAPCE-data's piece position 56 ; RADEL-delimiter (field separator) 57 S RAHL70="",RAHL7X=0,RAHL7OFF=$L(RASEG,RADEL) 58 S RAHL7LST=$P(RASEG,RADEL,RAHL7OFF) 59 I RAPCE<RAHL7OFF S RAHL70=$P(RASEG,RADEL,RAPCE) D KILL Q RAHL70 60 I RAHL7OFF=RAPCE D ; check if data wraps to the next node (if any) 61 . S RAHL70=$P(RASEG,RADEL,RAPCE),II1=$O(^TMP("RARPT-HL7",$J,RASUB,0)) 62 . S:'II1 RAHL7X=1 Q:'II1 63 . S RAHL70=RAHL70_$P(^TMP("RARPT-HL7",$J,RASUB,II1),RADEL),RAHL7X=1 64 . Q 65 I RAHL7X D KILL Q RAHL70 66 ; check if this node has descendent data nodes 67 I '$O(^TMP("RARPT-HL7",$J,RASUB,0)) D KILL Q "" ; descendents not found 68 S I=0,RAHL7CNT=RAHL7OFF 69 F S I=$O(^TMP("RARPT-HL7",$J,RASUB,I)) Q:I'>0 D Q:RAHL7X 70 . S RAHL7SUB=$G(^TMP("RARPT-HL7",$J,RASUB,I)) 71 . S RAHL7PRE=$O(^TMP("RARPT-HL7",$J,RASUB,I),-1) 72 . S:RAHL7PRE RAHL7LST=$$LSTPCE(^TMP("RARPT-HL7",$J,RASUB,RAHL7PRE),RADEL) 73 . F II1=1:1:$L(RAHL7SUB,RADEL) D Q:RAHL7X 74 .. ; HL7 may have broken the string on data! 75 .. I II1=1 S RAHL7ARY(RAHL7CNT)=RAHL7LST_$P(RAHL7SUB,RADEL) 76 .. E D ; for the case II1'=1 77 ... S RAHL7CNT=RAHL7CNT+1 78 ... S RAHL7ARY(RAHL7CNT)=$P(RAHL7SUB,RADEL,II1) 79 ... Q 80 .. I RAHL7CNT=RAPCE,(II1'=$L(RAHL7SUB,RADEL)) S RAHL7X=1,RAHL70=RAHL7ARY(RAHL7CNT) 81 .. I RAHL7CNT=RAPCE,(II1=$L(RAHL7SUB,RADEL)) D 82 ... ; grab the 1st piece of the next node (if any) 83 ... S RAHL7X=1,RAHL70=RAHL7ARY(RAHL7CNT) 84 ... S N1=+$O(^TMP("RARPT-HL7",$J,RASUB,I)) Q:'N1 85 ... S RAHL70=RAHL70_$P(^TMP("RARPT-HL7",$J,RASUB,N1),RADEL) 86 ... Q 87 .. K:'RAHL7X RAHL7ARY 88 .. Q 89 . Q 90 D KILL 91 Q RAHL70 92 KILL ; kill the RAHLD* variables 93 K I,II1,N1,RAHL7ARY,RAHL7CNT,RAHL7LST,RAHL7OFF,RAHL7PRE,RAHL7SUB,RAHL7X 94 Q 95 LSTPCE(X,DEL) ; given a string and a delimiter, return the last piece 96 Q $P(X,DEL,$L(X,DEL)) 97 CKDUPA ; if duplicate addendum, send msg to members of unverify rpt mailgroup 98 S RADUPA=0 ; 0 means not a duplicate 99 N I1,I2,X1,X2,X3,X4,X21,R0,R1,R2,MATCH,XMSUB 100 S I1="I",I2="RAIMP" I $O(^RARPT(RARPT,I1,0))'="" D ISITDUP ;Q:'RADUPA 101 ; 102 I 'RADUPA S I1="R",I2="RATXT" I $O(^RARPT(RARPT,I1,0))'="" D ISITDUP Q:'RADUPA 103 ;S I1="R",I2="RATXT" I $O(^RARPT(RARPT,I1,0))'="" D ISITDUP Q:'RADUPA 104 ; 105 S XMSUB="Duplicate addendum being sent to Vista" 106 ; 107 ; check to see if mail message already sent for 108 ; this case no. TODAY only. if so quit - no need to 109 ; re-send to save time backwards $ORDER, duplicate 110 ; most likely to be most recently. 111 S (XMB,XMATCH)="" 112 D NOW^%DTC S RATDY=X K X 113 F S XMB=$O(^XMB(3.9,"B",$E(XMSUB,1,30),XMB),-1) Q:XMB="" D Q:XMATCH'="" 114 .I $P($$GET1^DIQ(3.9,XMB,1.4,"I"),".")'=RATDY S XMATCH=0 Q ;(DBIA2860) 115 .Q:$G(^XMB(3.9,XMB,2,6,0))'[RALONGCN 116 .S XMATCH=1 117 K XMB,RATDY 118 Q:XMATCH=1 119 ; 120 ; send mail to members of unverify bulletin (DBIA2861) 121 ; find ien of unverify bulletin 122 D FIND^DIC(3.6,"","","","RAD/NUC MED REPORT UNVERIFIED",1,"","","","R0") 123 Q:'$D(R0("DILIST",2,1))#2 124 ; find name of mail group linked to that bulletin 125 D GETS^DIQ(3.6,R0("DILIST",2,1),"4*","EI","R1") 126 ; check to see if MailGroup is PUBLIC, otherwise quit 127 S X=$G(R1(3.62,"1,"_R0("DILIST",2,1)_",",.01,"I")) I X="" K X Q 128 I $$GET1^DIQ(3.8,X_",",4,"I")'="PU" K X Q 129 S X=$G(R1(3.62,"1,"_R0("DILIST",2,1)_",",.01,"E")) I X="" K X Q 130 N XMDUZ,XMTEXT,XMY,MSGTXT,XRAVERF,XRATRANS,XRADFN 131 S X="G."_X,XMY(X)="" K X ;recipient mail group 132 ; 133 S XMDUZ=.5 134 S MSGTXT(1)=$G(^TMP("RARPT-REC",$J,RASUB,"VENDOR"))_" is sending duplicate addenda to Radiology/Nuclear Medicine." 135 S MSGTXT(2)=" " 136 S MSGTXT(3)="The following radiology report was sent with a duplicate addendum:" 137 S:RADFN'="" XRADFN=$$GET1^DIQ(2,RADFN,.01) 138 S:$G(XRADFN)="" XRADFN="Unknown" 139 S MSGTXT(4)=" 1) Patient : "_XRADFN 140 S MSGTXT(5)=" 2) SSN : "_$$SSN^RAUTL() 141 S MSGTXT(6)=" 3) Case Number : "_RALONGCN 142 S:RAVERF'="" XRAVERF=$$GET1^DIQ(200,RAVERF,.01) 143 S:$G(XRAVERF)="" XRAVERF="Unknown" 144 S MSGTXT(7)=" 4) Verifier : "_XRAVERF 145 S:RATRANSC'="" XRATRANS=$$GET1^DIQ(200,RATRANSC,.01) 146 S:$G(XRATRANS)="" XRATRANS="Unknown" 147 S MSGTXT(8)=" 5) Transcriptionist : "_XRATRANS 148 S MSGTXT(9)=" " 149 S MSGTXT(10)="Please notify IRM." 150 S XMTEXT="MSGTXT(" 151 D ^XMD 152 Q 153 ISITDUP ; X1=last ien ^RARPT, X2=LAST IEN ^TMP, x21=first ien ^TMP 154 Q:'$O(^TMP("RARPT-REC",$J,RASUB,I2,0)) 155 N X1,X2,X21,X3,X4,XX 156 S RADUPA=0 ; Reset to zero otherwise Imp Text match will override 157 S X1=$O(^RARPT(RARPT,I1,""),-1) 158 S XX=$G(^RARPT(RARPT,I1,X1,0)) S XX=$S(XX=""!(XX=" "):0,1:1) 159 S X2=$O(^TMP("RARPT-REC",$J,RASUB,I2,""),-1),X21=$O(^(0)) 160 S X3=X1-X2+XX Q:X3<1 ; begin comparison from ^RARPT(RARPT,I1,X3 161 ; chk 1st line of previous addendum 162 Q:^RARPT(RARPT,I1,X3,0)'["Addendum: " S X4=^(0) 163 S X4=$E(X4,$L("Addendum: ")+1,$L(X4)) ; exclude "Addendum: " from X4 164 Q:X4'=^TMP("RARPT-REC",$J,RASUB,I2,X21) 165 ; chk remaining lines 166 S X21=X21+1 F X1=X21:1:X2 S X3=X3+1 Q:^RARPT(RARPT,I1,X3,0)'=^TMP("RARPT-REC",$J,RASUB,I2,X1) 167 Q:X1<X2 168 S RADUPA=1 169 Q
Note:
See TracChangeset
for help on using the changeset viewer.
