| 1 | GMRCITST ;SLC/JFR - test IFC setup ; 11/30/01 10:30
|
|---|
| 2 | ;;3.0;CONSULT/REQUEST TRACKING;**22**;DEC 27, 1997
|
|---|
| 3 | EN ; 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
|
|---|
| 19 | RUN(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 | ;
|
|---|
| 64 | TSTPROC(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 | ;
|
|---|
| 80 | TSTSERV(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 | ;
|
|---|
| 96 | ROUTE(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
|
|---|
