INHSG ;JSH,LD; 19 Oct 1999 11:27 ;Generic Interface - Generator routines [ 06/26/2001 10:51 AM ]
;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
;COPYRIGHT 1991-2000 SAIC
;CHCS TOOLS_460; GEN 4; 21-APR-1997
;COPYRIGHT 1988, 1989, 1990 SAIC
;
TRX(INX,INT,IND) ;Transformation entry point
; called from INTX FileMan function
;INX = data
;INT = type of data (from file 4012.1)
;IND = direction (I or O)
N X,Y,DIC
I IND=""!("IO"'[IND) Q INX
S X=INT,DIC="^INTHL7FT(",DIC(0)="MZ" D ^DIC
Q:Y<0 INX
S INT=+Y,X=INX
I IND="I" X $G(^INTHL7FT(INT,2)) Q $G(X)
X $G(^INTHL7FT(INT,3)) Q $G(X)
;
MEDT ;Message Entry/Edit
; INSTD = INTERFACE STANDARD
;
K DIC,DIE,DA,Y,DWN
N INSTD,DDSFILE,DR,DDSPAGE,DDSPARM,DDSSAVE,INFORM
W !! S DIC="^INTHL7M(",DIC(0)="QAELM",DIC("A")="Select MESSAGE: " D ^DIC K DIC Q:Y<0
S BHL("MSG")=+Y ;cmi/sitka/maw get message ien
;Determine namespace, default to "HL" (HL7)
S INSTD=$P(^INTHL7M(+Y,0),U,12),INSTD=$S(INSTD="NCPDP":"NC",INSTD="HL7":"HL7",INSTD="X12":"X12",1:"HL")
S DIE="^INTHL7M(",DA=+Y
S DWN=$S($G(INSTD)="X12":"INHSG X12 MESSAGE",$G(INSTD)="NC":"INHSG NCPDP MESSAGE",1:"INHSG MESSAGE")
I $$SC^INHUTIL1 D G:'$D(DWFILE) MEDT
.S INFORM=1 D ^DWC
;IHS Branch
I '$$SC^INHUTIL1,$D(^DIST(.403,"B",DWN)) D G:'$G(DDSSAVE) MEDT
.S DDSFILE=DIE,DR="["_DWN_"]",DDSPAGE=1,DDSPARM="SC",INFORM=1
.D ^DDS
I '$$SC^INHUTIL1,'$G(INFORM) S DR="[INHSG MESSAGE]" D ^DIE
D CHARUP^BHLU(BHL("MSG")) ;cmi/sitka/maw update enc chars
W !! S X=$$YN^UTSRD("Generate Scripts? ;1","") G:'X MEDT
S Y=DA D EN^INHSGZ G MEDT
;
FEDT ;Field Entry/Edit
K DIC,DIE,DA,Y,DWN
W !! S DIC="^INTHL7F(",DIC(0)="QAELM",DIC("A")="Select FIELD: " D ^DIC K DIC Q:Y<0
S DIE="^INTHL7F(",DA=+Y D EDIT^INHT("INHSG FIELD") G FEDT
;
SEDT ;Segment Entry/Edit
K DIC,DIE,DA,Y,DWN
W !! S DIC="^INTHL7S(",DIC(0)="QAELM",DIC("A")="Select SEGMENT: " D ^DIC K DIC Q:Y<0
S DIE="^INTHL7S(",DA=+Y D EDIT^INHT("INHSG SEGMENT") G SEDT
;
DEDT ;Data Type Entry/Edit
K DIC,DIE,DA,Y,DWN
W !! S DIC="^INTHL7FT(",DIC(0)="QAELM",DIC("A")="Select DATA TYPE: " D ^DIC K DIC Q:Y<0
S DIE="^INTHL7FT(",DA=+Y D EDIT^INHT("INHSG DATA TYPE") G DEDT
;
OTHER ;Other functionality in window
Q:'$D(DWFCHG) Q:'X N DIC,Y,INF
I X D
. D MESS^DWD() S DIC=1,DIC(0)="QAEM" D ^DIC S:Y>0 DWSFLD(.05)=$P(Y,U,2),INF=+Y I Y<0 S DWSFLD(.04)="NO" Q
. S DIC=.402,DIC(0)="QAE",DIC("S")="I $P(^(0),U,4)=INF" D ^DIC
. I Y<0 S DWSFLD(.04)="NO" Q
. S DWSFLD(.06)=$P(Y,U,2)
. W ! S X=$$SOC^UTIL("Lookup Parameter: ;;;;FORCED LAYGO;;;1","","FORCED LAYGO^NO LAYGO^LAYGO ALLOWED",0) I X=""!($E(X)=U) S DWSFLD(.04)="NO" Q
. S DWSFLD(.07)=$E(X)
Q
;
;
INHSG ;JSH,LD; 19 Oct 1999 11:27 ;Generic Interface - Generator routines [ 06/26/2001 10:51 AM ]
+1 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
+2 ;COPYRIGHT 1991-2000 SAIC
+3 ;CHCS TOOLS_460; GEN 4; 21-APR-1997
+4 ;COPYRIGHT 1988, 1989, 1990 SAIC
+5 ;
TRX(INX,INT,IND) ;Transformation entry point
+1 ; called from INTX FileMan function
+2 ;INX = data
+3 ;INT = type of data (from file 4012.1)
+4 ;IND = direction (I or O)
+5 NEW X,Y,DIC
+6 IF IND=""!("IO"'[IND)
QUIT INX
+7 SET X=INT
SET DIC="^INTHL7FT("
SET DIC(0)="MZ"
DO ^DIC
+8 IF Y<0
QUIT INX
+9 SET INT=+Y
SET X=INX
+10 IF IND="I"
XECUTE $GET(^INTHL7FT(INT,2))
QUIT $GET(X)
+11 XECUTE $GET(^INTHL7FT(INT,3))
QUIT $GET(X)
+12 ;
MEDT ;Message Entry/Edit
+1 ; INSTD = INTERFACE STANDARD
+2 ;
+3 KILL DIC,DIE,DA,Y,DWN
+4 NEW INSTD,DDSFILE,DR,DDSPAGE,DDSPARM,DDSSAVE,INFORM
+5 WRITE !!
SET DIC="^INTHL7M("
SET DIC(0)="QAELM"
SET DIC("A")="Select MESSAGE: "
DO ^DIC
KILL DIC
IF Y<0
QUIT
+6 ;cmi/sitka/maw get message ien
SET BHL("MSG")=+Y
+7 ;Determine namespace, default to "HL" (HL7)
+8 SET INSTD=$PIECE(^INTHL7M(+Y,0),U,12)
SET INSTD=$SELECT(INSTD="NCPDP":"NC",INSTD="HL7":"HL7",INSTD="X12":"X12",1:"HL")
+9 SET DIE="^INTHL7M("
SET DA=+Y
+10 SET DWN=$SELECT($GET(INSTD)="X12":"INHSG X12 MESSAGE",$GET(INSTD)="NC":"INHSG NCPDP MESSAGE",1:"INHSG MESSAGE")
+11 IF $$SC^INHUTIL1
Begin DoDot:1
+12 SET INFORM=1
DO ^DWC
End DoDot:1
IF '$DATA(DWFILE)
GOTO MEDT
+13 ;IHS Branch
+14 IF '$$SC^INHUTIL1
IF $DATA(^DIST(.403,"B",DWN))
Begin DoDot:1
+15 SET DDSFILE=DIE
SET DR="["_DWN_"]"
SET DDSPAGE=1
SET DDSPARM="SC"
SET INFORM=1
+16 DO ^DDS
End DoDot:1
IF '$GET(DDSSAVE)
GOTO MEDT
+17 IF '$$SC^INHUTIL1
IF '$GET(INFORM)
SET DR="[INHSG MESSAGE]"
DO ^DIE
+18 ;cmi/sitka/maw update enc chars
DO CHARUP^BHLU(BHL("MSG"))
+19 WRITE !!
SET X=$$YN^UTSRD("Generate Scripts? ;1","")
IF 'X
GOTO MEDT
+20 SET Y=DA
DO EN^INHSGZ
GOTO MEDT
+21 ;
FEDT ;Field Entry/Edit
+1 KILL DIC,DIE,DA,Y,DWN
+2 WRITE !!
SET DIC="^INTHL7F("
SET DIC(0)="QAELM"
SET DIC("A")="Select FIELD: "
DO ^DIC
KILL DIC
IF Y<0
QUIT
+3 SET DIE="^INTHL7F("
SET DA=+Y
DO EDIT^INHT("INHSG FIELD")
GOTO FEDT
+4 ;
SEDT ;Segment Entry/Edit
+1 KILL DIC,DIE,DA,Y,DWN
+2 WRITE !!
SET DIC="^INTHL7S("
SET DIC(0)="QAELM"
SET DIC("A")="Select SEGMENT: "
DO ^DIC
KILL DIC
IF Y<0
QUIT
+3 SET DIE="^INTHL7S("
SET DA=+Y
DO EDIT^INHT("INHSG SEGMENT")
GOTO SEDT
+4 ;
DEDT ;Data Type Entry/Edit
+1 KILL DIC,DIE,DA,Y,DWN
+2 WRITE !!
SET DIC="^INTHL7FT("
SET DIC(0)="QAELM"
SET DIC("A")="Select DATA TYPE: "
DO ^DIC
KILL DIC
IF Y<0
QUIT
+3 SET DIE="^INTHL7FT("
SET DA=+Y
DO EDIT^INHT("INHSG DATA TYPE")
GOTO DEDT
+4 ;
OTHER ;Other functionality in window
+1 IF '$DATA(DWFCHG)
QUIT
IF 'X
QUIT
NEW DIC,Y,INF
+2 IF X
Begin DoDot:1
+3 DO MESS^DWD()
SET DIC=1
SET DIC(0)="QAEM"
DO ^DIC
IF Y>0
SET DWSFLD(.05)=$PIECE(Y,U,2)
SET INF=+Y
IF Y<0
SET DWSFLD(.04)="NO"
QUIT
+4 SET DIC=.402
SET DIC(0)="QAE"
SET DIC("S")="I $P(^(0),U,4)=INF"
DO ^DIC
+5 IF Y<0
SET DWSFLD(.04)="NO"
QUIT
+6 SET DWSFLD(.06)=$PIECE(Y,U,2)
+7 WRITE !
SET X=$$SOC^UTIL("Lookup Parameter: ;;;;FORCED LAYGO;;;1","","FORCED LAYGO^NO LAYGO^LAYGO ALLOWED",0)
IF X=""!($EXTRACT(X)=U)
SET DWSFLD(.04)="NO"
QUIT
+8 SET DWSFLD(.07)=$EXTRACT(X)
End DoDot:1
+9 QUIT
+10 ;
+11 ;