- 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/RAHLRPC.m
r613 r623 1 RAHLRPC ;HIRMFO/BNT-Rad/NM HL7 Protocol calls ;05/21/99 14:50 2 ;;5.0;Radiology/Nuclear Medicine;**12,25,54,71,82,81,84**;Mar 16, 1998;Build 13 3 ; 03/16/2006 *71 Rem Call 124379 allow exam updates to create HL7 msg 4 ; 5 ;Integration Agreements 6 ;---------------------- 7 ;$$FIND1^DIC(2051); GETS^DIQ(2056) 8 ;all access to ^ORD(101 to maintain application specific protocols(872) 9 ;read w/FileMan HL7 APPLICATION PARAMETER(10136) 10 ; 11 REG ; register exam 12 N X,RA101Z,RAEID 13 S RA101Z="RA REF" ; get all protocols beginning RA REG 14 F S RA101Z=$O(^ORD(101,"B",RA101Z)) Q:RA101Z'["RA REG" D 15 .S RAEID=$O(^ORD(101,"B",RA101Z,0)) 16 .I RAEID,'$L($P(^ORD(101,RAEID,0),"^",3)) D EN^RAHLR 17 Q 18 CANCEL ; cancel exam 19 N X,RA101Z,RAEID 20 S RA101Z="RA CANCEK" ; get all protocols beginning RA CANCEL 21 F S RA101Z=$O(^ORD(101,"B",RA101Z)) Q:RA101Z'["RA CANCEL" D 22 .S RAEID=$O(^ORD(101,"B",RA101Z,0)) 23 .I RAEID,'$L($P(^ORD(101,RAEID,0),"^",3)) D EN^RAHLR 24 Q 25 ; 26 RPT ; report verified or released/not verified 27 N X,RA101Z,RAEID,RASSS ; RASSS subcriber array to be passed to HLL for GENERATE^HLMA 28 ;S X="^%ET",@^%ZOSF("TRAP") 29 S RA101Z="RA RPS" ; get all protocols beginning RA RPT 30 F S RA101Z=$O(^ORD(101,"B",RA101Z)) Q:RA101Z'["RA RPT" D 31 .S RAEID=$O(^ORD(101,"B",RA101Z,0)) K RASSS ; RA*5*81 32 .S:$L($G(RANOSEND)) RAEID=$$GETEID(RAEID,RANOSEND,.RASSS) ;RA*5*81 33 .I RAEID,'$L($P(^ORD(101,RAEID,0),"^",3)) D EN^RAHLRPT 34 K RANOSEND 35 Q 36 ; 37 EXM ;Examined case; called from RAUTL1 and RASTED after a case has been edited. 38 ; 39 ;Called from RAUTL1 and RASTED after a case's status is upgraded 40 ; and case's 30th piece is null 41 ; 42 ;If this new status is : 43 ; at a status (or higher than a status) where 44 ; GENERATE EXAMINED HL7 MSG = Y, 45 ; then : 46 ; 1. send an HL7 msg re this case having reached EXAMINED status 47 ; 2. set subfile 70.03's HL7 EXAMINED MSG SENT to Y 48 ; 49 ; RALOWER = next lower status 50 ; RANEWST = new status ien 51 ; RAEXEDT = Indication of editing of: proc, proc mod, req phys, CPT mod, Tech comm... 52 ; RAGENHL7 = Indication that sending ORU is due... 53 ; RASSSX1(IENs) = Array of subscribers from 771, the message will be sent (SCIMGE) 54 ; 55 N RAIMGTYI,RAIMGTYJ,RALOWER,RANEWST,RAEXMDUN,RAGENHL7,RASSSX1 56 S RAIMGTYI=$P($G(^RADPT(RADFN,"DT",RADTI,0)),U,2),RAIMGTYJ=$P(^RA(79.2,RAIMGTYI,0),U),RANEWST=$P($G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)),U,3) 57 S:$P(^RA(72,RANEWST,0),U,8)="Y" RAGENHL7=1 ;this status has GEN HL7 marked Y 58 ; look thru lower statuses for GEN HL7 marked Y 59 DOWN S RALOWER=$P($G(^RA(72,+RANEWST,0)),U,3) 60 I '$G(RAGENHL7) F S RALOWER=$O(^RA(72,"AA",RAIMGTYJ,RALOWER),-1) Q:RALOWER<1 S:$P(^RA(72,+$O(^RA(72,"AA",RAIMGTYJ,RALOWER,0)),0),U,8)="Y" RAGENHL7=1 61 ;?? none of the lower status levels have GEN HL7 marked Y 62 K:$P(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),U,30)="Y" RAGENHL7 ;already sent 63 ;Q:'$G(RAEXEDT)&'$G(RAGENHL7) 64 ; Business Rule: RA*5*84 sends an examined message to ScImage unconditionally 65 I '$G(RAEXEDT),'$G(RAGENHL7) Q:'$O(^RA(79.7,0)) D Q:'$O(RASSSX1(0)) 66 .N X,RASSS,RASSSL S X=0 F S X=$O(^RA(79.7,X)) Q:'X S:$P(^(X,0),U,2) RASSS(X)="" 67 .D:$D(RASSS) GETSUB^RAHLRS1(.RASSS,.RASSSX1,.RASSSL) 68 1 N RAEXMDUN 69 S RAEXMDUN=1 70 A1 N X,RA101Z,RAEID 71 S RA101Z="RA EXAMINEC" ; get all protocols beginning RA EXAMINED 72 F S RA101Z=$O(^ORD(101,"B",RA101Z)) Q:RA101Z'["RA EXAMINED" D 73 .N RAGENHL7 S RAEID=$O(^ORD(101,"B",RA101Z,0)) 74 .I RAEID,'$L($P(^ORD(101,RAEID,0),"^",3)) D EN^RAHLR 75 S:$G(RAGENHL7) $P(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),U,30)="Y" 76 Q 77 ; 78 GETEID(RAEID,RANOSEND,RASSS) ; RA*5*81 Return RAEID or 0 (zero) = for future use. 79 ; RAEID = IEN of regular Event driver 80 ; RANOSEND Application name or IEN from 771 file.. don't send message to Subcr. with this application. 81 ; RASSS Array of subcribers (IENs) associated with RANOSEND application 82 ; 0 (zero) returned if No subscriber exist or all subscribers associated with RANOSEND application. 83 S RAEID=$G(RAEID) Q:'RAEID!'$L($G(RANOSEND))!'$D(^ORD(101,+RAEID,0)) RAEID 84 N RAXX,ERR,X1,Y1,YY,RAPL,RANEW,RAPIDS,RAIEDS,DIERR,RAERR 85 S RAPL=$S(+RANOSEND:+RANOSEND,1:$$FIND1^DIC(771,"","X",RANOSEND,"","","RAERR")) 86 Q:'RAPL!($D(RAERR)#2) RAEID 87 D GETS^DIQ(101,RAEID_",","**","I","RAXX","ERR") 88 Q:$D(ERR) RAEID ; Was not able get Event driver info... so just pass event driver... 89 Q:'$D(RAXX(101.0775)) 0 ;No subcribers exist for Event driver 90 S X1="",RANEW=0,Y1=0 F S X1=$O(RAXX(101.0775,X1)) Q:'$L(X1) D 91 .S YY=$G(RAXX(101.0775,X1,.01,"I")) 92 .I $P($G(^ORD(101,+YY,770)),U,2)=RAPL D Q 93 ..S Y1=Y1+1,RASSS("EXCLUDE SUBSCRIBER",Y1)=YY ;Y1= 1,2,3... 94 .S RANEW=1 95 Q:'RANEW 0 ;All subscribers are associated with application RANOSEND.. Don't send the message. 96 Q RAEID 1 RAHLRPC ;HIRMFO/BNT-Rad/NM HL7 Protocol calls ;05/21/99 14:50 2 ;;5.0;Radiology/Nuclear Medicine;**12,25,54,71,82,81**;Mar 16, 1998;Build 12 3 ; 03/16/2006 *71 Rem Call 124379 allow exam updates to create HL7 msg 4 REG ; register exam 5 N X,RAPID,RAEID 6 S RAPID="RA REF" ; get all protocols beginning RA REG 7 F S RAPID=$O(^ORD(101,"B",RAPID)) Q:RAPID'["RA REG" D 8 .S RAEID=$O(^ORD(101,"B",RAPID,0)) 9 .I RAEID,'$L($P(^ORD(101,RAEID,0),"^",3)) D EN^RAHLR 10 Q 11 CANCEL ; cancel exam 12 N X,RAPID,RAEID 13 S RAPID="RA CANCEK" ; get all protocols beginning RA CANCEL 14 F S RAPID=$O(^ORD(101,"B",RAPID)) Q:RAPID'["RA CANCEL" D 15 .S RAEID=$O(^ORD(101,"B",RAPID,0)) 16 .I RAEID,'$L($P(^ORD(101,RAEID,0),"^",3)) D EN^RAHLR 17 Q 18 ; 19 RPT ; report verified or released/not verified 20 N X,RAPID,RAEID,RASSS ; RASSS subcriber array to be passed to HLL for GENERATE^HLMA 21 ;S X="^%ET",@^%ZOSF("TRAP") 22 S RAPID="RA RPS" ; get all protocols beginning RA RPT 23 F S RAPID=$O(^ORD(101,"B",RAPID)) Q:RAPID'["RA RPT" D 24 .S RAEID=$O(^ORD(101,"B",RAPID,0)) K RASSS ; RA*5*81 25 .S:$L($G(RANOSEND)) RAEID=$$GETEID(RAEID,RANOSEND,.RASSS) ;RA*5*81 26 .I RAEID,'$L($P(^ORD(101,RAEID,0),"^",3)) D EN^RAHLRPT 27 K RANOSEND 28 Q 29 ; 30 EXM ;Examined case; called from RAUTL1 and RASTED after a case has been edited. 31 ; 32 ;Called from RAUTL1 and RASTED after a case's status is upgraded 33 ; and case's 30th piece is null 34 ; 35 ;If this new status is : 36 ; at a status (or higher than a status) where 37 ; GENERATE EXAMINED HL7 MSG = Y, 38 ; then : 39 ; 1. send an HL7 msg re this case having reached EXAMINED status 40 ; 2. set subfile 70.03's HL7 EXAMINED MSG SENT to Y 41 ; 42 ; RALOWER = next lower status 43 ; RANEWST = new status ien 44 ; RAEXEDT = Indication of editing of: proc, proc mod, req phys, CPT mod, Tech comm... 45 ; RAGENHL7 = Indication that sending ORU is due... 46 ; 47 N RAIMGTYI,RAIMGTYJ,RALOWER,RANEWST,RAEXMDUN,RAGENHL7 48 S RAIMGTYI=$P($G(^RADPT(RADFN,"DT",RADTI,0)),U,2),RAIMGTYJ=$P(^RA(79.2,RAIMGTYI,0),U),RANEWST=$P($G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)),U,3) 49 S:$P(^RA(72,RANEWST,0),U,8)="Y" RAGENHL7=1 ;this status has GEN HL7 marked Y 50 ; look thru lower statuses for GEN HL7 marked Y 51 DOWN S RALOWER=$P($G(^RA(72,+RANEWST,0)),U,3) 52 I '$G(RAGENHL7) F S RALOWER=$O(^RA(72,"AA",RAIMGTYJ,RALOWER),-1) Q:RALOWER<1 S:$P(^RA(72,+$O(^RA(72,"AA",RAIMGTYJ,RALOWER,0)),0),U,8)="Y" RAGENHL7=1 53 ;?? none of the lower status levels have GEN HL7 marked Y 54 K:$P(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),U,30)="Y" RAGENHL7 ;already sent 55 Q:'$G(RAEXEDT)&'$G(RAGENHL7) 56 ; 57 1 N RAEXMDUN 58 S RAEXMDUN=1 59 A1 N X,RAPID,RAEID 60 S RAPID="RA EXAMINEC" ; get all protocols beginning RA EXAMINED 61 F S RAPID=$O(^ORD(101,"B",RAPID)) Q:RAPID'["RA EXAMINED" D 62 .N RAGENHL7 S RAEID=$O(^ORD(101,"B",RAPID,0)) 63 .I RAEID,'$L($P(^ORD(101,RAEID,0),"^",3)) D EN^RAHLR 64 S:$G(RAGENHL7) $P(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),U,30)="Y" 65 Q 66 ; 67 GETEID(RAEID,RANOSEND,RASSS) ; RA*5*81 Return RAEID or 0 (zero) = for future use. 68 ; RAEID = IEN of regular Event driver 69 ; RANOSEND Application name or IEN from 771 file.. don't send message to Subcr. with this application. 70 ; RASSS Array of subcribers (IENs) associated with RANOSEND application 71 ; 0 (zero) returned if No subscriber exist or all subscribers associated with RANOSEND application. 72 S RAEID=$G(RAEID) Q:'RAEID!'$L($G(RANOSEND))!'$D(^ORD(101,+RAEID,0)) RAEID 73 N RAXX,ERR,X1,Y1,YY,RAPL,RANEW,RAPIDS,RAIEDS 74 S RAPL=$S(+RANOSEND:+RANOSEND,1:$O(^HL(771,"B",RANOSEND,0))) Q:'RAPL RAEID 75 D GETS^DIQ(101,RAEID_",","**","I","RAXX","ERR") 76 Q:$D(ERR) RAEID ; Was not able get Event driver info... so just pass event driver... 77 Q:'$D(RAXX(101.0775)) 0 ;No subcribers exist for Event driver 78 S X1="",RANEW=0,Y1=0 F S X1=$O(RAXX(101.0775,X1)) Q:'$L(X1) D 79 .S YY=$G(RAXX(101.0775,X1,.01,"I")) 80 .I $P($G(^ORD(101,+YY,770)),U,2)=RAPL D Q 81 ..S Y1=Y1+1,RASSS("EXCLUDE SUBSCRIBER",Y1)=YY ;Y1= 1,2,3... 82 .S RANEW=1 83 Q:'RANEW 0 ;All subscribers are associated with application RANOSEND.. Don't send the message. 84 Q RAEID
Note:
See TracChangeset
for help on using the changeset viewer.
