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

HLCSHDR5.m

Go to the documentation of this file.
  1. HLCSHDR5 ;OIRMFO/LJA - Make HL7 header for TCP ;1/27/03 15:30
  1. ;;1.6;HEALTH LEVEL SEVEN;**93**;Oct 13, 1995
  1. ;
  1. ; The MSHALL API is not supported!
  1. ;
  1. MSHALL ; Allows application developer, in test and development environments,
  1. ; to change almost every field in the MSH segment. This feature
  1. ; allows the testing of the ramifications of MSH field changes, avoiding
  1. ; the need to edit protocol file (and other file) entries from which
  1. ; the MSH segment fields are derived.
  1. ;
  1. ; Call here ONLY if the full suite of variables used in MSH segment
  1. ; creation are available!
  1. ;
  1. ; Call method: S HLP("SUBSCRIBER"[,n])="^^^^^MSHALL^HLCSHDR5"
  1. ; D GENERATE^HLMA(.....,.HLP)
  1. ;
  1. ; When the above HLP array is passed into the
  1. ; GENERATE^HLMA API, the MSHALL subroutine is
  1. ; invoked, giving the developer full control over
  1. ; most MSH segment fields; even those fields not
  1. ; changeable by HL*1.6*93.
  1. ;
  1. ; See HL*1.6*93 for information about the passing
  1. ; of HLP("SUBSCRIBER"[,n]) information, and the
  1. ; calling of the GENERATE^HLMA API.
  1. ;
  1. ; Warning! No audit trail (in ^HLMA or ^XTMP) is maintained.
  1. ; Full responsibility rests with the application
  1. ; developer.
  1. ;
  1. ; EC,FS -- req
  1. ;
  1. N ACTION,CHANGE,IOINHI,IOINORM,MSHFINAL,MSHLAST,MSHORIG
  1. N SAVE,PCE,VAL1,VAL2,X
  1. ;
  1. D SAVEORIG
  1. S (MSHFINAL,MSHLAST)=MSHORIG
  1. ;
  1. MSHCONT ;
  1. F D Q:'CHANGE
  1. . S CHANGE=0
  1. . D SHOWMSH
  1. . D ASKMSH
  1. . S MSHFINAL=$$MSH
  1. . QUIT:MSHFINAL=MSHLAST ;->
  1. . S CHANGE=1
  1. . S MSHLAST=$$MSH
  1. ;
  1. I MSHFINAL=MSHORIG W !!,"The MSH segment was not changed..."
  1. I MSHFINAL'=MSHORIG D
  1. . S X="IOINHI;IOINORM" D ENDR^%ZISS
  1. . W !!,MSHORIG,!!," changed to...",!!
  1. . F PCE=1:1:$L(MSHFINAL,FS) D
  1. . . W:PCE'=1 FS
  1. . . S VAL1=$P(MSHORIG,FS,PCE),VAL2=$P(MSHFINAL,FS,PCE)
  1. . . W:VAL1'=VAL2 IOINHI
  1. . . W VAL2
  1. . . W IOINORM
  1. ;
  1. S ACTION=$$DOWHAT
  1. I ACTION="B" D G MSHCONT ;->
  1. . QUIT:MSHFINAL=MSHORIG ;->
  1. . W !!,"You have made some changes to the original MSH segment. Do you want to"
  1. . W !,"""forget"" these changes, and reset the MSH segment to it's original state?"
  1. . QUIT:'$$YN("Reset MSH segment","No",1) ;->
  1. . D RESTORE
  1. . S (MSHFINAL,MSHLAST)=MSHORIG
  1. ;
  1. Q
  1. ;
  1. YN(PMT,DEF,FF) ;
  1. N DIR,DIRUT,DTOUT,DUOUT,X,Y
  1. F I=1:1:$G(FF) W !
  1. S DIR(0)="Y",DIR("A")=PMT
  1. S:$G(DEF)]"" DIR("B")=DEF
  1. D ^DIR
  1. Q $S(+Y=1:1,1:"")
  1. ;
  1. DOWHAT() ; Reenter MSH or send message...
  1. N DIR,DIRUT,DTOUT,DUOUT,X,Y
  1. S DIR(0)="S^B:Back up and change MSH segment;C:Continue on (and send message)"
  1. S DIR("A")="Enter ACTION",DIR("B")="Continue"
  1. D ^DIR
  1. QUIT $S(Y="B":"B",1:"C")
  1. ;
  1. SHOWMSH ;
  1. ; MSHORIG -- req
  1. N C2,C3,C4,DATA,IOINHI,IOINORM,MSH,PCE,REF,TAG,VAL,X,XEC
  1. ;
  1. S X=MSHORIG N MSHORIG S MSHORIG=X
  1. S C2=4,C3=18,C4=40
  1. I $G(FS)']""!($G(EC)']"") N EC,FS S FS=U,EC="~|\&"
  1. S X="IOINHI;IOINORM" D ENDR^%ZISS
  1. ;
  1. W @IOF,!,$$CJ^XLFSTR("MSH Segment Values",IOM)
  1. W !,$$REPEAT^XLFSTR("-",IOM)
  1. W !,"#",?C2,"Field",?C3,"Variable",?C4,"Value"
  1. W !,$$REPEAT^XLFSTR("=",IOM)
  1. ;
  1. F PCE=1:1 S DATA=$T(FLDS+PCE) Q:$E(DATA,1,3)'=" ;;"!(DATA']"") S DATA=$P(DATA,";;",2,99) D
  1. . S REF=$P(DATA,U),XEC=$P(DATA,U,2),TAG=$P(DATA,U,3)
  1. . S VAL=REF
  1. . I PCE=11 S REF=$TR(REF,"~",U)
  1. . I XEC=1,PCE'=12 S VAL=@REF
  1. . I XEC=2!(PCE=12) S X="S VAL="_REF X X KILL X
  1. . W !,$J(PCE,2),?C2,$$S(TAG,12),?C3,$$S(REF,18)
  1. . W ?C4
  1. . I XEC=1 W IOINHI
  1. . W VAL,IOINORM
  1. . W $S(XEC=1:$$CHG(VAL,PCE),1:"")
  1. ;
  1. Q
  1. ;
  1. S(T,C) QUIT:$L(T)<(C+1) T ;->
  1. QUIT $E(T,1,C-1)_"~"
  1. ;
  1. CHG(VAL,PCE) ; Has data been changed?
  1. ; MSHORIG -- req
  1. N VALORIG
  1. S VALORIG=$P(MSHORIG,FS,+PCE)
  1. QUIT:VALORIG=VAL "" ;->
  1. Q " *"
  1. ;
  1. ASKMSH ; Ask user to input different field values
  1. N DATA,DIR,DIRUT,DTOUT,DUOUT,FIELD,PCE,TITLE,VAL,VAR,X,Y
  1. ;
  1. W !
  1. ;
  1. S DIR="SOA^"
  1. F PCE=3:1:12,15:1:17 D
  1. . S DATA=$P($T(FLDS+PCE),";;",2,999),VAR=$P(DATA,U),TITLE=$P(DATA,U,3)
  1. . S DIR=DIR_$S(PCE>3:";",1:"")_PCE_":"_TITLE_" ("_VAR_")"
  1. S DIR(0)=DIR
  1. S DIR("A")="Enter FIELD #: "
  1. D ^DIR
  1. QUIT:+Y'>0 ;->
  1. ;
  1. S FIELD=+Y,VAR=$P($P($T(FLDS+FIELD),";;",2,99),U)
  1. I FIELD'=12 S VAL=@VAR
  1. I FIELD=12 S X="S VAL="_VAR X X KILL X
  1. ;
  1. W !!,"Current '",VAR,"' value = ",VAL
  1. W !
  1. ;
  1. KILL DIR,DIRUT,DTOUT,DUOUT,X,Y
  1. S DIR(0)="F",DIR("A")="Field value"
  1. D ^DIR
  1. QUIT:$D(DIRUT)!($D(DTOUT))!($D(DUOUT)) ;->
  1. ;
  1. S ANS=Y
  1. ;
  1. I ANS=VAL W " nothing changed..." QUIT ;->
  1. ;
  1. ; Make the change...
  1. I FIELD'=12 S @VAR=ANS
  1. I FIELD=12 S $P(PROT,U,9)=ANS
  1. W " changed..."
  1. ;
  1. Q
  1. ;
  1. MSH() ;Build MSH array
  1. N DATA,MSH,PCE,REF,TAG,XEC
  1. ;
  1. S MSH=""
  1. ;
  1. F PCE=1:1 S DATA=$T(FLDS+PCE) Q:$E(DATA,1,3)'=" ;;"!(DATA']"") S DATA=$P(DATA,";;",2,99) D
  1. . S REF=$P(DATA,U),XEC=$P(DATA,U,2)
  1. . I PCE=11 S REF=$TR(REF,"~",U)
  1. . I XEC=0 S VAL=REF
  1. . I XEC=1,PCE'=12 S VAL=@REF
  1. . I XEC=2!(PCE=12) S X="S VAL="_REF X X KILL X
  1. . S MSH=MSH_$S(MSH]"":FS,1:"")_VAL
  1. ;
  1. Q MSH
  1. ;
  1. SAVEORIG ; Save value of original variables...
  1. KILL SAVE
  1. ;
  1. S SAVE("SERAPP")=SERAPP,SAVE("SERFAC")=SERFAC
  1. S SAVE("CLNTAPP")=CLNTAPP,SAVE("CLNTFAC")=CLNTFAC
  1. S SAVE("HLDATE")=HLDATE,SAVE("SECURITY")=SECURITY
  1. S SAVE("MSGTYPE")=MSGTYPE,SAVE("HLID")=HLID
  1. S SAVE("HLPID")=HLPID,SAVE("ACCACK")=ACCACK
  1. S SAVE("APPACK")=APPACK,SAVE("CNTRY")=CNTRY
  1. S SAVE("$P(PROT,U,9)")=$P(PROT,U,9)
  1. ;
  1. S MSHORIG=$$MSH
  1. ;
  1. Q
  1. ;
  1. RESTORE ;
  1. N VAL,VAR
  1. ;
  1. ; restore variables...
  1. S VAR=""
  1. F S VAR=$O(SAVE(VAR)) Q:VAR']"" D
  1. . QUIT:VAR["$P(PROT,U,9)" ;->
  1. . S @VAR=SAVE(VAR)
  1. S $P(PROT,U,9)=SAVE("$P(PROT,U,9)")
  1. ;
  1. ; Restore beginning MSH...
  1. S (MSHFINAL,MSHLAST)=MSHORIG
  1. ;
  1. Q
  1. ;
  1. FLDS ; List of fields and their variables in MSH segment...
  1. ;;MSH^0
  1. ;;EC^2
  1. ;;SERAPP^1^SND-APP
  1. ;;SERFAC^1^SND-FAC
  1. ;;CLNTAPP^1^REC-APP
  1. ;;CLNTFAC^1^REC-FAC
  1. ;;HLDATE^1^D/T
  1. ;;SECURITY^1^SECURE
  1. ;;MSGTYPE^1^MSGTYPE
  1. ;;HLID^1^MSG-ID
  1. ;;HLPID^1^PID
  1. ;;$P(PROT,U,9)^1^VERSION
  1. ;;^0
  1. ;;^0^CONTINUATION
  1. ;;ACCACK^1^COMACK
  1. ;;APPACK^1^APPACK
  1. ;;CNTRY^1^COUNTRY
  1. Q
  1. ;
  1. PRACTICE ; Practice MSH variables...
  1. S EC="~|\&",FS=U
  1. S SERAPP="SND-APP",SERFAC=512,CLNTAPP="REC-APP",CLNTFAC=661
  1. S HLDATE=200301020135,SECURITY="SEC",MSGTYPE="ORU~R01"
  1. S HLID="543010101",HLPID="P"
  1. S $P(PROT,U,9)="2.3",TXTP=999
  1. S ACCACK="AL",APPACK="AL",CNTRY="US"
  1. Q
  1. ;
  1. ;
  1. EOR ;HLCSHDR5 - Make HL7 header for TCP ;1/27/03 15:30