source: FOIAVistA/trunk/r/CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT/GMRCITST.m@ 1657

Last change on this file since 1657 was 628, checked in by George Lilly, 16 years ago

initial load of FOIAVistA 6/30/08 version
File size: 4.1 KB
Line 
1GMRCITST ;SLC/JFR - test IFC setup ; 11/30/01 10:30
2 ;;3.0;CONSULT/REQUEST TRACKING;**22**;DEC 27, 1997
3EN ; start here
4 ;Prompt for choice of consult service or procedure
5 ;route to the ROUTING FACILITY and see if it's a GO
6 N DIR,X,Y,DIROUT,DIRUT,DTOUT
7 S DIR(0)="SO^P:procedure;C:consult service"
8 S DIR("A")="Would you like to test a procedure or consult service"
9 D ^DIR
10 I $D(DIRUT) Q
11 W !!
12 D RUN(Y)
13 W !!
14 K DIR,X,Y
15 S DIR(0)="YA",DIR("A")="Would you like to test another implementation? "
16 D ^DIR
17 I Y=1 G EN
18 Q
19RUN(GMRCTYP) ; check the procedure or service for proper setup
20 N DIR,X,Y,DIROUT,DIRUT,DTOUT,SERV,PROC,GMRC773,HLL,LINK,HL
21 I GMRCTYP="P" D
22 . S DIR(0)="PA^123.3:EMQ"
23 . S DIR("A")="Select the GMRC Procedure that you'd like to test: "
24 I GMRCTYP="C" D
25 . S DIR(0)="PA^123.5:EMQ"
26 . S DIR("A")="Select the Consult service that you'd like to test: "
27 . S DIR("A")="Select the Consult service that you'd like to test: "
28 D ^DIR
29 I $G(Y)'>0 W !,"No procedure or service selected." Q
30 I GMRCTYP="P" S PROC=+Y I '$$TSTPROC(PROC) Q
31 I GMRCTYP="C" S SERV=+Y I '$$TSTSERV(SERV) Q
32 ;
33 ;send msg
34 K ^TMP("HLS",$J)
35 D INIT^HLFNC2("GMRC IFC ORM TEST",.HL)
36 S ^TMP("HLS",$J,1)=$$ORCTST^GMRCISG1
37 I $G(PROC) S ^TMP("HLS",$J,2)=$$OBRTST^GMRCISG1(PROC,"P")
38 I $G(SERV) S ^TMP("HLS",$J,2)=$$OBRTST^GMRCISG1(SERV,"C")
39 S LINK=$$ROUTE($S($G(PROC):PROC_";GMR(123.3,",1:SERV_";GMR(123.5,"))
40 I '$L(LINK) D Q ;problem with the HL LOGICAL LINK
41 . W !!,"The proper HL LOGICAL link could not be located!"
42 . W !,"Can't continue to test. Contact IRM."
43 S HLL("LINKS",1)=LINK
44 W !!," attempting to connect to remote system...",!
45 D DIRECT^HLMA("GMRC IFC ORM TEST","GM",1,.GMRC773)
46 I +$P(GMRC773,U,2) D Q ;problem with the HL link
47 . W !,"There was a problem communicating with the remote site."
48 . W !,"IRM may need to check the HL7 communications."
49 N HLNODE,SEG,I ;process response
50 K ^TMP("GMRCIF",$J)
51 F I=1:1 X HLNEXT Q:HLQUIT'>0 D
52 .S ^TMP("GMRCIF",$J,$P(HLNODE,"|"))=$E(HLNODE,5,999)
53 I $P(^TMP("GMRCIF",$J,"MSA"),"|")="AA" D
54 . W !!,"Congratulations! You're configured correctly."
55 I $P(^TMP("GMRCIF",$J,"MSA"),"|")="AR" D
56 . N ERR,GMRCER
57 . W !!,"There is an implementation problem. The remote site indicated:"
58 . S ERR=$P(^TMP("GMRCIF",$J,"MSA"),"|",3),GMRCER=+ERR
59 . I ERR S ERR="ERR"_ERR_"^GMRCIUTL" S ERR=$T(@ERR),ERR=$P(ERR,";",2)
60 . W !,?5,ERR_$S(+GMRCER:" ("_GMRCER_")",1:" (HL7 ERROR)")
61 K ^TMP("GMRCIF",$J),^TMP("HLS",$J),HLNEXT,HLQUIT
62 Q
63 ;
64TSTPROC(GMRCPR) ;check procedure and make sure it has required fields for IFC
65 ; Input:
66 ; GMRCPR = ien from file 123.3
67 ;
68 ; Output:
69 ; 1 = configured correctly
70 ; 0 = one or more fields missing
71 ;
72 I '$D(^GMR(123.3,GMRCPR,"IFC")) D Q 0
73 . W !!,"This procedure is not configured for Inter-facility purposes."
74 I '$P(^GMR(123.3,GMRCPR,"IFC"),U) D Q 0
75 . W !!,"This procedure has no IFC ROUTING FACILITY entered."
76 I '$L($P(^GMR(123.3,GMRCPR,"IFC"),U,2)) D Q 0
77 . W !!,"This procedure has no IFC REMOTE NAME entered."
78 Q 1
79 ;
80TSTSERV(GMRCSS) ;check service and make sure it has required fields for IFC
81 ; Input:
82 ; GMRCSS = ien from file 123.5
83 ;
84 ; Output:
85 ; 1 = configured correctly
86 ; 0 = one or more fields missing
87 ;
88 I '$D(^GMR(123.5,GMRCSS,"IFC")) D Q 0
89 . W !!,"This service is not configured for Inter-facility purposes."
90 I '$P(^GMR(123.5,GMRCSS,"IFC"),U) D Q 0
91 . W !!,"This service has no IFC ROUTING FACILITY entered."
92 I '$L($P(^GMR(123.5,GMRCSS,"IFC"),U,2)) D Q 0
93 . W !!,"This service has no IFC REMOTE NAME entered."
94 Q 1
95 ;
96ROUTE(GMRCOI) ; get the right HL link for testing
97 ;Input:
98 ; GMRCOI = ien from file 123.3 or 123.5 in var ptr format
99 ;
100 ;Output:
101 ; the logical link to send the message to in format
102 ; "GMRC IFC SUBSC^VHAHIN"
103 ;
104 N SITE,GMRCLINK,STA
105 I '$G(GMRCOI) Q ""
106 I $P(GMRCOI,";",2)[123.3 D
107 . S SITE=$P($G(^GMR(123.3,+GMRCOI,"IFC")),U)
108 I $P(GMRCOI,";",2)[123.5 D
109 . S SITE=$P($G(^GMR(123.5,+GMRCOI,"IFC")),U)
110 I '$G(SITE) Q ""
111 S STA=$$STA^XUAF4(SITE)
112 I '$L(STA) Q ""
113 D LINK^HLUTIL3(STA,.GMRCLINK,"I")
114 S GMRCLINK=$O(GMRCLINK(0)) I 'GMRCLINK Q "" ; no link for that site
115 S GMRCLINK=GMRCLINK(GMRCLINK) I '$L(GMRCLINK) Q "" ;no link name
116 Q "GMRC IFC SUBSC^"_GMRCLINK
Note: See TracBrowser for help on using the repository browser.