INHSGZ ; cmi/flag/maw - JSH 15 Oct 1999 14:52 Interface - Generate a script ; [ 05/22/2002 2:53 PM ]
;;3.01;BHL IHS Interfaces with GIS;**1**;JUL 01, 2001
;COPYRIGHT 1991-2000 SAIC
;CHCS TOOLS_460; GEN 3; 17-JUL-1997
;COPYRIGHT 1991, 1992 SAIC
;
K DIC S DIC="^INTHL7M(",DIC(0)="QAEM" D ^DIC
K INGALL
;
EN ;Enter here with Y= internal entry # of message
Q:Y<0
N INDUZ M INDUZ=DUZ N DUZ S DUZ=.5,DUZ(0)="@",DUZ("AG")=$G(INDUZ("AG"))
L +^INTHL7M(+Y):0 E W !,*7,"Another user is working with this entry." Q
N DMAX,MESS,TRT,MODE,INSS,ERR,INHSZ,INSTD S INHSZ=1
S MESS=+Y Q:'$D(^INTHL7M(MESS,0)) S MESS(0)=^INTHL7M(MESS,0)
W !!,"Generation for message: "_$P(MESS(0),U)
I $P(MESS(0),U,8) W ".. Inactive (aborting)" Q
;Set flag for interface standard (stored in field .12)
S INSTD=$P(MESS(0),U,12),INSTD=$S(INSTD="NCPDP":"NC",INSTD="HL7":"HL",INSTD="X12":"X12",1:"HL")
D SETDT^UTDT S TRT=0,INSS=$G(^INTHL7M(MESS,"S")) K ^("S")
F S TRT=$O(^INTHL7M(MESS,2,TRT)) Q:'TRT D ONE(+^(TRT,0))
L -^INTHL7M(MESS)
S INSS=$G(^INTHL7M(MESS,"S")) I INSS=""!(INSS="^") W !,*7,"No scripts were generated!" G QT
W !!,"The following scripts were generated:"
F I=1,2 I $P(INSS,U,I) W !?5,$P(^INRHS($P(INSS,U,I),0),U)
W !
I '$G(INGALL) S X=$$YN^UTSRD("Do you wish to compile the script(s) now? ;1","") G:'X QT
F INI=1,2 I $P(INSS,U,INI) S SCR=$P(INSS,U,INI) D EN^INHSZ
QT K ^UTILITY("INS",$J),^UTILITY("INDIA",$J),SNAME Q
;
ONE(%T) ;Compile one transaction type
;%T = entry number of the transaction type
W "."
Q:'$G(%T) Q:'$D(^INRHT(%T))!'$D(^INTHL7M(+MESS,0))
S MODE=$P(^INRHT(%T,0),U,8) Q:MODE=""!("IO"'[MODE)
Q:$D(ERR(MODE))
S X=$P($G(^INTHL7M(MESS,"S")),U,MODE="O"+1) I X S $P(^INRHT(%T,0),U,3)=X Q
S SNAME="Generated: "_$E($P(MESS(0),U),1,40)_"-"_MODE
S X=$P(INSS,U,MODE="O"+1) I X S SCR=X G:$P($G(^INRHS(SCR,0)),U)=SNAME COMP S $P(INSS,U,MODE="O"+1)=""
S SCR=$$MAKENEW^INHSC Q:'SCR
COMP ;At this point, the entry # of the script is known in SCR
N DA,DIK,I,%,FILE,INISTD K ^UTILITY("INS",$J)
K ^INRHS(SCR,1)
K DIC,Y S DIC="^INRHS(",DIC(0)="Y",X=SNAME D ^DIC D:Y'<0
. S:Y Y(+Y)="" K Y(+SCR)
. S DA=0,DIK="^INRHS(" F S DA=$O(Y(DA)) Q:'DA X "N Y D ^DIK"
S FILE=$P(MESS(0),U,5),INISTD=$P(MESS(0),U,12)
I '$D(^DIC(FILE,0)) W *7,!,"WARNING. There is no file ",FILE," in the system. Aborting script compilation",! S ERR=1 Q
S ERR=0 D OUT^INHSGZ1:MODE="O",IN^INHSGZ2:MODE="I"
I ERR S ERR(MODE)="" W !?5,"... generation of all ",$P("IN^OUT",U,MODE="O"+1),"PUT scripts is aborted." K:^INRHS(SCR,0)="" ^INRHS(SCR) Q
;Adding interface standard 6/8 dgh
I $G(^INRHS(SCR,0))]"" S DIE="^INRHS(",DA=SCR,DR=".03////"_FILE_";.07///"_INISTD D ^DIE
I $G(^INRHS(SCR,0))="" S ^INRHS(SCR,0)=SNAME_U_MODE_U_FILE_U_U_1_U_U_INISTD,DA=SCR,DIK="^INRHS(" D IX1^DIK
S (%,I)=0 F S I=$O(^UTILITY("INS",$J,I)) Q:'I S %=%+1,^INRHS(SCR,1,%,0)=^UTILITY("INS",$J,I)
S ^INRHS(SCR,1,0)=U_U_%_U_%
S $P(^INRHT(%T,0),U,3)=SCR
S $P(^INTHL7M(MESS,"S"),U,MODE="O"+1)=SCR
Q
;
ALL ;Regerate all
W !!,*7,"WARNING: This option will regenerate all active messages." S X=$$YN^UTSRD("Proceed? ;0","") Q:'X
ALLAUTO ;Automatically regenerate
N INGALL,INHSGZ
S INGALL=1,INHSGZ=0 F S INHSGZ=$O(^INTHL7M(INHSGZ)) Q:'INHSGZ S Y=INHSGZ D EN
Q
INHSGZ ; cmi/flag/maw - JSH 15 Oct 1999 14:52 Interface - Generate a script ; [ 05/22/2002 2:53 PM ]
+1 ;;3.01;BHL IHS Interfaces with GIS;**1**;JUL 01, 2001
+2 ;COPYRIGHT 1991-2000 SAIC
+3 ;CHCS TOOLS_460; GEN 3; 17-JUL-1997
+4 ;COPYRIGHT 1991, 1992 SAIC
+5 ;
+6 KILL DIC
SET DIC="^INTHL7M("
SET DIC(0)="QAEM"
DO ^DIC
+7 KILL INGALL
+8 ;
EN ;Enter here with Y= internal entry # of message
+1 IF Y<0
QUIT
+2 NEW INDUZ
MERGE INDUZ=DUZ
NEW DUZ
SET DUZ=.5
SET DUZ(0)="@"
SET DUZ("AG")=$GET(INDUZ("AG"))
+3 LOCK +^INTHL7M(+Y):0
IF '$TEST
WRITE !,*7,"Another user is working with this entry."
QUIT
+4 NEW DMAX,MESS,TRT,MODE,INSS,ERR,INHSZ,INSTD
SET INHSZ=1
+5 SET MESS=+Y
IF '$DATA(^INTHL7M(MESS,0))
QUIT
SET MESS(0)=^INTHL7M(MESS,0)
+6 WRITE !!,"Generation for message: "_$PIECE(MESS(0),U)
+7 IF $PIECE(MESS(0),U,8)
WRITE ".. Inactive (aborting)"
QUIT
+8 ;Set flag for interface standard (stored in field .12)
+9 SET INSTD=$PIECE(MESS(0),U,12)
SET INSTD=$SELECT(INSTD="NCPDP":"NC",INSTD="HL7":"HL",INSTD="X12":"X12",1:"HL")
+10 DO SETDT^UTDT
SET TRT=0
SET INSS=$GET(^INTHL7M(MESS,"S"))
KILL ^("S")
+11 FOR
SET TRT=$ORDER(^INTHL7M(MESS,2,TRT))
IF 'TRT
QUIT
DO ONE(+^(TRT,0))
+12 LOCK -^INTHL7M(MESS)
+13 SET INSS=$GET(^INTHL7M(MESS,"S"))
IF INSS=""!(INSS="^")
WRITE !,*7,"No scripts were generated!"
GOTO QT
+14 WRITE !!,"The following scripts were generated:"
+15 FOR I=1,2
IF $PIECE(INSS,U,I)
WRITE !?5,$PIECE(^INRHS($PIECE(INSS,U,I),0),U)
+16 WRITE !
+17 IF '$GET(INGALL)
SET X=$$YN^UTSRD("Do you wish to compile the script(s) now? ;1","")
IF 'X
GOTO QT
+18 FOR INI=1,2
IF $PIECE(INSS,U,INI)
SET SCR=$PIECE(INSS,U,INI)
DO EN^INHSZ
QT KILL ^UTILITY("INS",$JOB),^UTILITY("INDIA",$JOB),SNAME
QUIT
+1 ;
ONE(%T) ;Compile one transaction type
+1 ;%T = entry number of the transaction type
+2 WRITE "."
+3 IF '$GET(%T)
QUIT
IF '$DATA(^INRHT(%T))!'$DATA(^INTHL7M(+MESS,0))
QUIT
+4 SET MODE=$PIECE(^INRHT(%T,0),U,8)
IF MODE=""!("IO"'[MODE)
QUIT
+5 IF $DATA(ERR(MODE))
QUIT
+6 SET X=$PIECE($GET(^INTHL7M(MESS,"S")),U,MODE="O"+1)
IF X
SET $PIECE(^INRHT(%T,0),U,3)=X
QUIT
+7 SET SNAME="Generated: "_$EXTRACT($PIECE(MESS(0),U),1,40)_"-"_MODE
+8 SET X=$PIECE(INSS,U,MODE="O"+1)
IF X
SET SCR=X
IF $PIECE($GET(^INRHS(SCR,0)),U)=SNAME
GOTO COMP
SET $PIECE(INSS,U,MODE="O"+1)=""
+9 SET SCR=$$MAKENEW^INHSC
IF 'SCR
QUIT
COMP ;At this point, the entry # of the script is known in SCR
+1 NEW DA,DIK,I,%,FILE,INISTD
KILL ^UTILITY("INS",$JOB)
+2 KILL ^INRHS(SCR,1)
+3 KILL DIC,Y
SET DIC="^INRHS("
SET DIC(0)="Y"
SET X=SNAME
DO ^DIC
IF Y'<0
Begin DoDot:1
+4 IF Y
SET Y(+Y)=""
KILL Y(+SCR)
+5 SET DA=0
SET DIK="^INRHS("
FOR
SET DA=$ORDER(Y(DA))
IF 'DA
QUIT
XECUTE "N Y D ^DIK"
End DoDot:1
+6 SET FILE=$PIECE(MESS(0),U,5)
SET INISTD=$PIECE(MESS(0),U,12)
+7 IF '$DATA(^DIC(FILE,0))
WRITE *7,!,"WARNING. There is no file ",FILE," in the system. Aborting script compilation",!
SET ERR=1
QUIT
+8 SET ERR=0
IF MODE="O"
DO OUT^INHSGZ1
IF MODE="I"
DO IN^INHSGZ2
+9 IF ERR
SET ERR(MODE)=""
WRITE !?5,"... generation of all ",$PIECE("IN^OUT",U,MODE="O"+1),"PUT scripts is aborted."
IF ^INRHS(SCR,0)=""
KILL ^INRHS(SCR)
QUIT
+10 ;Adding interface standard 6/8 dgh
+11 IF $GET(^INRHS(SCR,0))]""
SET DIE="^INRHS("
SET DA=SCR
SET DR=".03////"_FILE_";.07///"_INISTD
DO ^DIE
+12 IF $GET(^INRHS(SCR,0))=""
SET ^INRHS(SCR,0)=SNAME_U_MODE_U_FILE_U_U_1_U_U_INISTD
SET DA=SCR
SET DIK="^INRHS("
DO IX1^DIK
+13 SET (%,I)=0
FOR
SET I=$ORDER(^UTILITY("INS",$JOB,I))
IF 'I
QUIT
SET %=%+1
SET ^INRHS(SCR,1,%,0)=^UTILITY("INS",$JOB,I)
+14 SET ^INRHS(SCR,1,0)=U_U_%_U_%
+15 SET $PIECE(^INRHT(%T,0),U,3)=SCR
+16 SET $PIECE(^INTHL7M(MESS,"S"),U,MODE="O"+1)=SCR
+17 QUIT
+18 ;
ALL ;Regerate all
+1 WRITE !!,*7,"WARNING: This option will regenerate all active messages."
SET X=$$YN^UTSRD("Proceed? ;0","")
IF 'X
QUIT
ALLAUTO ;Automatically regenerate
+1 NEW INGALL,INHSGZ
+2 SET INGALL=1
SET INHSGZ=0
FOR
SET INHSGZ=$ORDER(^INTHL7M(INHSGZ))
IF 'INHSGZ
QUIT
SET Y=INHSGZ
DO EN
+3 QUIT
