Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: GMRCITST

GMRCITST.m

Go to the documentation of this file.
  1. GMRCITST ;SLC/JFR - test IFC setup ; 11/30/01 10:30
  1. ;;3.0;CONSULT/REQUEST TRACKING;**22**;DEC 27, 1997
  1. EN ; start here
  1. ;Prompt for choice of consult service or procedure
  1. ;route to the ROUTING FACILITY and see if it's a GO
  1. N DIR,X,Y,DIROUT,DIRUT,DTOUT
  1. S DIR(0)="SO^P:procedure;C:consult service"
  1. S DIR("A")="Would you like to test a procedure or consult service"
  1. D ^DIR
  1. I $D(DIRUT) Q
  1. W !!
  1. D RUN(Y)
  1. W !!
  1. K DIR,X,Y
  1. S DIR(0)="YA",DIR("A")="Would you like to test another implementation? "
  1. D ^DIR
  1. I Y=1 G EN
  1. Q
  1. RUN(GMRCTYP) ; check the procedure or service for proper setup
  1. N DIR,X,Y,DIROUT,DIRUT,DTOUT,SERV,PROC,GMRC773,HLL,LINK,HL
  1. I GMRCTYP="P" D
  1. . S DIR(0)="PA^123.3:EMQ"
  1. . S DIR("A")="Select the GMRC Procedure that you'd like to test: "
  1. I GMRCTYP="C" D
  1. . S DIR(0)="PA^123.5:EMQ"
  1. . S DIR("A")="Select the Consult service that you'd like to test: "
  1. . S DIR("A")="Select the Consult service that you'd like to test: "
  1. D ^DIR
  1. I $G(Y)'>0 W !,"No procedure or service selected." Q
  1. I GMRCTYP="P" S PROC=+Y I '$$TSTPROC(PROC) Q
  1. I GMRCTYP="C" S SERV=+Y I '$$TSTSERV(SERV) Q
  1. ;
  1. ;send msg
  1. K ^TMP("HLS",$J)
  1. D INIT^HLFNC2("GMRC IFC ORM TEST",.HL)
  1. S ^TMP("HLS",$J,1)=$$ORCTST^GMRCISG1
  1. I $G(PROC) S ^TMP("HLS",$J,2)=$$OBRTST^GMRCISG1(PROC,"P")
  1. I $G(SERV) S ^TMP("HLS",$J,2)=$$OBRTST^GMRCISG1(SERV,"C")
  1. S LINK=$$ROUTE($S($G(PROC):PROC_";GMR(123.3,",1:SERV_";GMR(123.5,"))
  1. I '$L(LINK) D Q ;problem with the HL LOGICAL LINK
  1. . W !!,"The proper HL LOGICAL link could not be located!"
  1. . W !,"Can't continue to test. Contact IRM."
  1. S HLL("LINKS",1)=LINK
  1. W !!," attempting to connect to remote system...",!
  1. D DIRECT^HLMA("GMRC IFC ORM TEST","GM",1,.GMRC773)
  1. I +$P(GMRC773,U,2) D Q ;problem with the HL link
  1. . W !,"There was a problem communicating with the remote site."
  1. . W !,"IRM may need to check the HL7 communications."
  1. N HLNODE,SEG,I ;process response
  1. K ^TMP("GMRCIF",$J)
  1. F I=1:1 X HLNEXT Q:HLQUIT'>0 D
  1. .S ^TMP("GMRCIF",$J,$P(HLNODE,"|"))=$E(HLNODE,5,999)
  1. I $P(^TMP("GMRCIF",$J,"MSA"),"|")="AA" D
  1. . W !!,"Congratulations! You're configured correctly."
  1. I $P(^TMP("GMRCIF",$J,"MSA"),"|")="AR" D
  1. . N ERR,GMRCER
  1. . W !!,"There is an implementation problem. The remote site indicated:"
  1. . S ERR=$P(^TMP("GMRCIF",$J,"MSA"),"|",3),GMRCER=+ERR
  1. . I ERR S ERR="ERR"_ERR_"^GMRCIUTL" S ERR=$T(@ERR),ERR=$P(ERR,";",2)
  1. . W !,?5,ERR_$S(+GMRCER:" ("_GMRCER_")",1:" (HL7 ERROR)")
  1. K ^TMP("GMRCIF",$J),^TMP("HLS",$J),HLNEXT,HLQUIT
  1. Q
  1. ;
  1. TSTPROC(GMRCPR) ;check procedure and make sure it has required fields for IFC
  1. ; Input:
  1. ; GMRCPR = ien from file 123.3
  1. ;
  1. ; Output:
  1. ; 1 = configured correctly
  1. ; 0 = one or more fields missing
  1. ;
  1. I '$D(^GMR(123.3,GMRCPR,"IFC")) D Q 0
  1. . W !!,"This procedure is not configured for Inter-facility purposes."
  1. I '$P(^GMR(123.3,GMRCPR,"IFC"),U) D Q 0
  1. . W !!,"This procedure has no IFC ROUTING FACILITY entered."
  1. I '$L($P(^GMR(123.3,GMRCPR,"IFC"),U,2)) D Q 0
  1. . W !!,"This procedure has no IFC REMOTE NAME entered."
  1. Q 1
  1. ;
  1. TSTSERV(GMRCSS) ;check service and make sure it has required fields for IFC
  1. ; Input:
  1. ; GMRCSS = ien from file 123.5
  1. ;
  1. ; Output:
  1. ; 1 = configured correctly
  1. ; 0 = one or more fields missing
  1. ;
  1. I '$D(^GMR(123.5,GMRCSS,"IFC")) D Q 0
  1. . W !!,"This service is not configured for Inter-facility purposes."
  1. I '$P(^GMR(123.5,GMRCSS,"IFC"),U) D Q 0
  1. . W !!,"This service has no IFC ROUTING FACILITY entered."
  1. I '$L($P(^GMR(123.5,GMRCSS,"IFC"),U,2)) D Q 0
  1. . W !!,"This service has no IFC REMOTE NAME entered."
  1. Q 1
  1. ;
  1. ROUTE(GMRCOI) ; get the right HL link for testing
  1. ;Input:
  1. ; GMRCOI = ien from file 123.3 or 123.5 in var ptr format
  1. ;
  1. ;Output:
  1. ; the logical link to send the message to in format
  1. ; "GMRC IFC SUBSC^VHAHIN"
  1. ;
  1. N SITE,GMRCLINK,STA
  1. I '$G(GMRCOI) Q ""
  1. I $P(GMRCOI,";",2)[123.3 D
  1. . S SITE=$P($G(^GMR(123.3,+GMRCOI,"IFC")),U)
  1. I $P(GMRCOI,";",2)[123.5 D
  1. . S SITE=$P($G(^GMR(123.5,+GMRCOI,"IFC")),U)
  1. I '$G(SITE) Q ""
  1. S STA=$$STA^XUAF4(SITE)
  1. I '$L(STA) Q ""
  1. D LINK^HLUTIL3(STA,.GMRCLINK,"I")
  1. S GMRCLINK=$O(GMRCLINK(0)) I 'GMRCLINK Q "" ; no link for that site
  1. S GMRCLINK=GMRCLINK(GMRCLINK) I '$L(GMRCLINK) Q "" ;no link name
  1. Q "GMRC IFC SUBSC^"_GMRCLINK