- 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 ;
