Changeset 636 for FOIAVistA/tag/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAHLRS1.m

Timestamp:

Dec 4, 2009, 8:26:01 PM (14 years ago)

Author:

George Lilly

Message:

WorldVistAEHR overlayed on FOIAVistA

Location:

FOIAVistA/tag/r

Files:

• . (copied) (copied from FOIAVistA/trunk/r )
• RADIOLOGY_NUCLEAR_MEDICINE-RA/RAHLRS1.m (modified) (7 diffs)

FOIAVistA/tag/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAHLRS1.m

@@ -1 +1 @@
 RAHLRS1 ;HIRMFO/ROB/PAVEL - Resend HL7 messages for selected Timeframe ; 4/2/07 3:42pm
- ;;5.0;Radiology/Nuclear Medicine;**80,84**;Mar 16, 1998;Build 13
+ ;;5.0;Radiology/Nuclear Medicine;**80**;Mar 01, 2007;Build 19
+ ;
  ; Utility to RESEND HL7 messages for selected Timeframe
- ;
- ;Integration Agreements
- ;----------------------
- ;^%DT(10003); C^%DTC(10000); H^%DTC(10000); ^%ZISC(10089); ^%ZTLOAD(10063); $$GET1^DIQ(2056)
- ;^DIR(10026); ^XMD(10070)
- ;all access to ^ORD(101 to maintain application specific protocols(872)
- ;read w/FileMan HL7 APPLICATION PARAMETER(10136)
  ;
  N RACNI,RADFN,RADTI,RARPT,X,RAED,RABD,RASHBD,RASHED,RASHTD,RASHTM,DIC,DA,XX,YY
@@ -30 +24 @@
  S RAED=RAED_"."_9999
  K XX G:'$$GETAP(.XX) STOP
- W !!,"*** Pick the application in which to send the radiology data ***",!!
+ W !!,"****Pick the application to send the RAD data to*****",!!
  F I=1:1 Q:'$D(XX(I))  W !,"  #",I,"   ",$O(XX(I,""))
-2 ;user selects the application
- S DIR(0)="N^1:"_(I-1)
- W ! S DIR("?")="Please select an available application from the list."
- D ^DIR Q:$D(DIRUT)
+2 S DIR(0)="N"
+ W ! S DIR("?")="Please select an available application from the list"
+ D ^DIR Q:$D(DIRUT)  I (X'<1),(X'<I) W "Please select an available application from the list" G 2
  W !!,"The: ",$O(XX(+X,"")),"   will be the recipient"
  W !!,"Reviewing exams for selected time period... (This may take a few minutes)... "
@@ -53 +46 @@
  W !,"Task ",$S('$D(ZTSK):" Has Not been Tasked !!!",1:"#:"_ZTSK_" Has been Tasked")
  D:$D(ZTSK)
- .N RAX,RAMPG,XMSUB,XMY,XMTEXT
- .S RAX(1)="Task #"_$G(ZTSK)_" is scheduled to run the option: "
- .S RAX(2)=">>Re-send HL7 messages for a date range and for designated Recipient.<<"
- .S RAX(3)=" Scheduled time to run: "_RASHTM
- .S RAX(4)="Date range from: "_$G(RASHBD)_" to: "_$G(RASHED)
+ .N X,RAMPG,XMSUB,XMY,XMTEXT
+ .S X(1)="Task #"_$G(ZTSK)_" is scheduled to run the option: "
+ .S X(2)=">>Re-send HL7 messages for a date range and for designated Recipient.<<"
+ .S X(3)=" Scheduled time to run: "_RASHTM
+ .S X(4)="Date range from: "_$G(RASHBD)_" to: "_$G(RASHED)
  .S XMSUB="TASKMAN SCHEDULE NOTIFICATION/INFO"
  .S RAMPG="G.RAD HL7 MESSAGES"
  .S XMY(RAMPG)="",XMDUZ=.5
- .S XMTEXT="RAX("
+ .S XMTEXT="X("
  .D ^XMD
  Q
@@ -72 +65 @@
  ..S RADTI=0 F  S RADTI=$O(^RADPT("AR",RABD,RADFN,RADTI)) Q:'RADTI  D
  ...S RACNI=0 F  S RACNI=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI)) Q:'RACNI  D RESEND(RADFN,RADTI,RACNI)
- K RAX S RAX(1)="Task #"_$G(ZTSK)_" successfully completed the option: "
- S RAX(2)=">>Re-send HL7 messages for a date range and for designated Recipient.<<"
- S RAX(3)="Date range from: "_$G(RASHBD)_" to: "_$G(RASHED)
- S RAX(4)="# Of RAD Reports transferred: "_$G(RASUM7R)
- S RAX(5)="# Of Exams transferred:      "_$G(RASUM7)
+ K X S X(1)="Task #"_$G(ZTSK)_" successfully completed the option: "
+ S X(2)=">>Re-send HL7 messages for a date range and for designated Recipient.<<"
+ S X(3)="Date range from: "_$G(RASHBD)_" to: "_$G(RASHED)
+ S X(4)="# Of RAD Reports transferred: "_$G(RASUM7R)
+ S X(5)="# Of Exams transferred:      "_$G(RASUM7)
  S:$G(RASUM7E) X(6)="# Of Exams not transferred because of ""BAD DATA"": "_$G(RASUM7E)
  S XMSUB="TASKMAN ""RESEND HL7 OPTION"" COMPLETED/INFO"
  S RAMPG="G.RAD HL7 MESSAGES"
  S XMY(RAMPG)="",XMDUZ=.5
- S XMTEXT="RAX("
+ S XMTEXT="X("
  D ^XMD
  G STOP
@@ -88 +81 @@
 RESEND(RADFN,RADTI,RACNI) ; re-send exam message(s) to HL7 subscribers
  ; for every 10 messages sent, make sure queue is not clogged... $$HANG
- N RAXAMP80 S RAXAMP80=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
- I '(+$P(RAXAMP80,U))!'($P(RAXAMP80,U,2)) S RASUM7E=RASUM7E+1 Q
- N RABD,RAEDP80,QUIT
+ I '(+^(RACNI,0)) S RASUM7E=RASUM7E+1 Q
+ I '$P(^(0),U,2) S RASUM7E=RASUM7E+1 Q
+ N RABD,RAED,QUIT
  ;
  I '$D(DT) D ^%DT S DT=Y
  ;
- S RAEDP80=$$RAED(RADFN,RADTI,RACNI)
- I '$L(RAEDP80) S RASUM7E=RASUM7E+1 Q
- D:RAEDP80[",REG,"
+ S RAED=$$RAED(RADFN,RADTI,RACNI)
+ I '$L(RAED) S RASUM7E=RASUM7E+1 Q
+ D:RAED[",REG,"
  .D CHSUM N RASUM7,RASUM7R,RASUM7E D REG^RAHLRPC
- D:RAEDP80[",CANCEL,"
+ D:RAED[",CANCEL,"
  .D CHSUM N RASUM7,RASUM7R,RASUM7E D CANCEL^RAHLRPC
- D:RAEDP80[",EXAM,"
+ D:RAED[",EXAM,"
  .D CHSUM
  .S $P(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),"^",30)="" ;Reset sent flag
  .N RASUM7,RAEXMDUN,RASUM7R,RASUM7E D 1^RAHLRPC
- D:RAEDP80[",RPT,"
+ D:RAED[",RPT,"
  .D CHSUM N RASUM7,RANOSEND,RASUM7R,RASUM7E,RARPT D RPT^RAHLRPC
  Q
@@ -153 +146 @@
  .F  S X1=$O(^ORD(101,"B",X1)) Q:X1'[X11  S X2=$O(^ORD(101,"B",X1,0)) Q:'X2  D
  ..K Z S X3=0 F  S X3=$O(^ORD(101,X2,775,X3)) Q:'X3  S Z(+^(X3,0))=""
- ..Q:'$D(Z)  K Z1 S X3=0 F  S X3=$O(Z(X3)) Q:'X3  D
- ...S Z1=$G(^ORD(101,X3,770)) S:+$P(Z1,U,2) XXX(+$P(Z1,U,2))=""
- S X1=0 F J=1:1 S X1=$O(XXX(X1)) Q:'X1  D
- .N DIERR,RAERR,Y
- .S Y=$$GET1^DIQ(771,X1,.01,"","","RAERR")
- .Q:Y=""!($D(RAERR)#2)  S XX(J,Y)=X1
- .Q
+ ..Q:'$D(Z)  K Z1 S X3=0 F  S X3=$O(Z(X3)) Q:'X3  S XXX(+$P($G(^ORD(101,X3,770)),U,2))=""
+ S X1=0 F J=1:1 S X1=$O(XXX(X1)) Q:'X1  S XX(J,$P(^HL(771,X1,0),U))=X1
  Q $S($D(XXX):1,1:0)
  ;
@@ -176 +164 @@
  ...S XX=+$P($G(^ORD(101,XX,770)),U,7) S:XX LINK(XX)=""
  Q
-GETHLP(RAEID,HLP,ADR) ; Get excluded subcribers set into HLP array
- N I,J,XX,AA S J=$O(HLP("EXCLUDE SUBSCRIBER",99999999),-1)
- ;XX Set the list of already excluded subscribers, so be sure we don't set it second time
- S AA=ADR_"("_RAEID_",I)"
- S I=0 F I=$O(HLP("EXCLUDE SUBSCRIBER",I)) Q:'I  S XX(HLP("EXCLUDE SUBSCRIBER",I))=""
- S I=0 F  S I=$O(@AA) Q:'I  S:'$D(XX(I)) J=J+1,HLP("EXCLUDE SUBSCRIBER",J)=I
+GETHLP(RAEID,HLP) ; Get excluded subcribers set into HLP array
+ N I,J,II S II=$O(HLP("EXCLUDE SUBSCRIBER",99999999),-1)+1
+ S I=0 F J=II:1 S I=$O(RASSSX(RAEID,I)) Q:'I  S HLP("EXCLUDE SUBSCRIBER",J)=I
  Q
 CHSUM ;CHECKSUM