IVM2078P ;ALB/EJG - Patch Post-Install functions IVM*2*78;04/07/2003
;;2.0;INCOME VERIFICATION;**78**;21-OCT-94
;
EN ;ENTRY POINT
;
N ADDR,PORT,STATION,TCPDATA,AN,RLLN,SLLN,STOP,VER,DA,FILE,RET,ERROR
;
; Get site's Station #
S STATION=$P($$SITE^VASITE,"^",3)
;
S STOP=0
D CLEANUP ;Cleanup message placed with wrong LL
Q:$$SETLL16(STATION,.RLLN,.SLLN)
D PROTOCOL(STATION,RLLN,SLLN,.AN)
Q
;
SETLL16(STATION,RLLN,SLLN) ;
;INPUT STATION = Station #
; RLLN = Receiving Logical Link Name
; SLLN = Sending Logical Link Name
;
;OUTPUT 0 : Success, 1 : Error
;
;PURPOSE Create the Receiving and Sending Logical Link.
;
N ADDR,PORT,RECVLL,SENDLL,RET,VISN,M,IENS
;
; Sending Logical Link
S SLLN="LLEDBOUT"
S PORT=33001 ;e*Gate Port#
S ADDR="127.0.0.1" ;e*Gate production
S RET=$$LL16(SLLN,ADDR,PORT,1)
I +RET<0 D ERROR(RET,"Edb Send Link:"_SLLN) Q 1
;
RLL ; Receiving Logical Link
S RLLN="LLEDBIN"
S ADDR=""
S PORT="" ;all stations production
S RET=$$LL16(RLLN,ADDR,PORT,0)
I +RET<0 D ERROR(RET,"Edb Receive Link:"_RLLN) Q 1
LL16EXIT Q STOP
;
;
PROTOCOL(STATION,RLLN,SLLN,AN) ;
;INPUT STATION = Station #
; RLLN = Receiving Logical Link Name
; SLLN = Sending Logical Link Name
; AN = Array containing the Application Names
;
;OUTPUT None
;
;PURPOSE Update the protocols (Subscriber and Event Driver) for the
; Edb/e*Gate TCP/IP interfaces
;
N RESULT,SIEN,DUZ,V,N,N1,LNCNT,LINE,PROTRET,NAM,DISABTXT
S DISABTXT=""
F NAM="EAS EDB ORU-Z06 SERVER","EAS EDB ORU-Z09 SERVER" D
. S RESULT=$$EDP(NAM,DISABTXT)
. I +RESULT<0 D ERROR(RESULT,"Event Driver:"_NAM)
Q
;
ERROR(ERRMSG,SUBJ) ;
;INPUT ERRMSG = Error Message text
; SUBJ = Subject of the Message
;
;OUTPUT none
;
;PURPOSE Display an error message to the user. Set the
; variable STOP=1 which will stop the routine
; from continuing to run after an error is found.
;
N TXT
S STOP=1
S TXT=$P(ERRMSG,"^",2)
W !,"===================================================="
W !,"= ERROR ="
W !,"===================================================="
W !,"When creating "_SUBJ
W !,"===================================================="
W !,"**ERROR MSG: ",TXT
Q
;
;Update Functions
;
LL16(LLNAME,TCPADDR,TCPPORT,AUTO) ;
;INPUT LLNAME = Logical Link Name (ex. "LLEDBOUT")
; TCPADDR = TCP/IP Address
; TCPPORT = TCP/IP Port #
; AUTO = AUTOSTART
; 0 - DISABLED
; 1 - ENABLED
;
;OUTPUT IEN of entry (#870) Success
; -1^Error Message Error
;
;PURPOSE Update a Logical Link for TCP/IP transmissions.
;
N FILE,DATA,RETURN,DEFINED,ERROR,DA,DGENDA
S FILE=870
; If already exists then skip
;
S IEN870=$O(^HLCS(870,"B",LLNAME,0)) ;IEN TO UPDATE
I 'IEN870 D Q RETURN ;IEN NOT FOUND - RETURN ERROR
. S ERROR="IEN OF RECORD TO BE UPDATED NOT SPECIFIED"
. S RETURN=-1_"^"_ERROR
;
; set v1.6 field values
S DATA(400.01)=TCPADDR ;TCP/IP ADDRESS
S DATA(400.02)=TCPPORT ;TCP/IP PORT
S DATA(4.5)=AUTO ;AUTOSTART
;
S RETURN=$$UPD^DGENDBS(FILE,IEN870,.DATA,.ERROR)
S:ERROR'=""!(+RETURN=0) RETURN=-1_"^"_ERROR
;
Q RETURN
;
EDP(PNAME,DTXT) ;
;INPUT PNAME = Protocol Name
; DTXT = Disable Text
;
;OUTPUT IEN entry (#101) of Event Driver Protocol Success
; -1^Error Message Error
;
;PURPOSE Activate the Event Driver Protocol
;
N DATA,FILE,DGENDA,RETURN,ERROR,DA,IEN101
S FILE=101
; If already exists then skip
;
S IEN101=$O(^ORD(101,"B",PNAME,0))
I 'IEN101 D Q RETURN ;IEN NOT FOUND - RETURN ERROR
. S ERROR="IEN OF RECORD TO BE UPDATED NOT SPECIFIED"
. S RETURN=-1_"^"_ERROR
;
S DATA(2)=DTXT ;DISABLE TEXT
S RETURN=$$UPD^DGENDBS(FILE,IEN101,.DATA,.ERROR)
I ERROR'=""!(+RETURN=0) S RETURN=-1_"^"_ERROR G EDPEXIT
;
EDPEXIT Q RETURN
;
;Clean up those message that have been placed into the EDB outbound
; logical link - LLEDBOUT erroneously. Delete them out of LLEDBOUT
; queue and place into general outbound queue.
;
CLEANUP N IEN870,VISN,M,IEN,QIEN,SLLN
S IEN870=$O(^HLCS(870,"B","LLEDBOUT",0))
I 'IEN870 Q
I '$D(^HLMA("AC","O",IEN870)) Q ;Nothing in queue
W !,"Requeue Z09 messages"
S IEN=0
F S IEN=$O(^HLMA("AC","O",IEN870,IEN)) Q:'IEN D
. W !?2,"Requeued Record# ",IEN
. L +^HLMA(IEN):0 Q:'$T
. D REQUEUE(IEN)
. L -^HLMA(IEN)
W !,"Requeue of records completed.",!
Q
;
;Requeue the transaction into the IVM Billing Transmission (#301.61)
; file
;
REQUEUE(IEN773) N DFN,HLTCP,IEN30161,IEN772,PFLG,REC,SEG,SEQ,SID
S IEN772=+$P($G(^HLMA(IEN773,0)),"^")
S (PFLG,SEQ)=0
F S SEQ=$O(^HL(772,IEN772,"IN",SEQ)) Q:'SEQ D
.I $P(^HL(772,IEN772,"IN",SEQ,0),"^")="PID" D
..S REC=$G(^HL(772,IEN772,"IN",SEQ,0))
..S DFN=+$P($P(REC,"^",4),"~")
..S PFLG=1
.I PFLG,$P(^HL(772,IEN772,"IN",SEQ,0),"^")="FT1" D
..S REC=$G(^HL(772,IEN772,"IN",SEQ,0))
..S SID=$P(REC,"^",8)
..S IEN30161=$O(^IVM(301.61,"B",SID,0))
..S ^IVM(301.61,"ATR",DFN,IEN30161)="" ;Requeue for IVM Billing
I 'PFLG Q ;PID Segment not found
S HLTCP=1
D STATUS^HLTF0(IEN773,3,,,1) ;Set 773 transaction to COMPLETE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIVM2078P 5628 printed Oct 16, 2024@18:01:20 Page 2
IVM2078P ;ALB/EJG - Patch Post-Install functions IVM*2*78;04/07/2003
+1 ;;2.0;INCOME VERIFICATION;**78**;21-OCT-94
+2 ;
EN ;ENTRY POINT
+1 ;
+2 NEW ADDR,PORT,STATION,TCPDATA,AN,RLLN,SLLN,STOP,VER,DA,FILE,RET,ERROR
+3 ;
+4 ; Get site's Station #
+5 SET STATION=$PIECE($$SITE^VASITE,"^",3)
+6 ;
+7 SET STOP=0
+8 ;Cleanup message placed with wrong LL
DO CLEANUP
+9 if $$SETLL16(STATION,.RLLN,.SLLN)
QUIT
+10 DO PROTOCOL(STATION,RLLN,SLLN,.AN)
+11 QUIT
+12 ;
SETLL16(STATION,RLLN,SLLN) ;
+1 ;INPUT STATION = Station #
+2 ; RLLN = Receiving Logical Link Name
+3 ; SLLN = Sending Logical Link Name
+4 ;
+5 ;OUTPUT 0 : Success, 1 : Error
+6 ;
+7 ;PURPOSE Create the Receiving and Sending Logical Link.
+8 ;
+9 NEW ADDR,PORT,RECVLL,SENDLL,RET,VISN,M,IENS
+10 ;
+11 ; Sending Logical Link
+12 SET SLLN="LLEDBOUT"
+13 ;e*Gate Port#
SET PORT=33001
+14 ;e*Gate production
SET ADDR="127.0.0.1"
+15 SET RET=$$LL16(SLLN,ADDR,PORT,1)
+16 IF +RET<0
DO ERROR(RET,"Edb Send Link:"_SLLN)
QUIT 1
+17 ;
RLL ; Receiving Logical Link
+1 SET RLLN="LLEDBIN"
+2 SET ADDR=""
+3 ;all stations production
SET PORT=""
+4 SET RET=$$LL16(RLLN,ADDR,PORT,0)
+5 IF +RET<0
DO ERROR(RET,"Edb Receive Link:"_RLLN)
QUIT 1
LL16EXIT QUIT STOP
+1 ;
+2 ;
PROTOCOL(STATION,RLLN,SLLN,AN) ;
+1 ;INPUT STATION = Station #
+2 ; RLLN = Receiving Logical Link Name
+3 ; SLLN = Sending Logical Link Name
+4 ; AN = Array containing the Application Names
+5 ;
+6 ;OUTPUT None
+7 ;
+8 ;PURPOSE Update the protocols (Subscriber and Event Driver) for the
+9 ; Edb/e*Gate TCP/IP interfaces
+10 ;
+11 NEW RESULT,SIEN,DUZ,V,N,N1,LNCNT,LINE,PROTRET,NAM,DISABTXT
+12 SET DISABTXT=""
+13 FOR NAM="EAS EDB ORU-Z06 SERVER","EAS EDB ORU-Z09 SERVER"
Begin DoDot:1
+14 SET RESULT=$$EDP(NAM,DISABTXT)
+15 IF +RESULT<0
DO ERROR(RESULT,"Event Driver:"_NAM)
End DoDot:1
+16 QUIT
+17 ;
ERROR(ERRMSG,SUBJ) ;
+1 ;INPUT ERRMSG = Error Message text
+2 ; SUBJ = Subject of the Message
+3 ;
+4 ;OUTPUT none
+5 ;
+6 ;PURPOSE Display an error message to the user. Set the
+7 ; variable STOP=1 which will stop the routine
+8 ; from continuing to run after an error is found.
+9 ;
+10 NEW TXT
+11 SET STOP=1
+12 SET TXT=$PIECE(ERRMSG,"^",2)
+13 WRITE !,"===================================================="
+14 WRITE !,"= ERROR ="
+15 WRITE !,"===================================================="
+16 WRITE !,"When creating "_SUBJ
+17 WRITE !,"===================================================="
+18 WRITE !,"**ERROR MSG: ",TXT
+19 QUIT
+20 ;
+21 ;Update Functions
+22 ;
LL16(LLNAME,TCPADDR,TCPPORT,AUTO) ;
+1 ;INPUT LLNAME = Logical Link Name (ex. "LLEDBOUT")
+2 ; TCPADDR = TCP/IP Address
+3 ; TCPPORT = TCP/IP Port #
+4 ; AUTO = AUTOSTART
+5 ; 0 - DISABLED
+6 ; 1 - ENABLED
+7 ;
+8 ;OUTPUT IEN of entry (#870) Success
+9 ; -1^Error Message Error
+10 ;
+11 ;PURPOSE Update a Logical Link for TCP/IP transmissions.
+12 ;
+13 NEW FILE,DATA,RETURN,DEFINED,ERROR,DA,DGENDA
+14 SET FILE=870
+15 ; If already exists then skip
+16 ;
+17 ;IEN TO UPDATE
SET IEN870=$ORDER(^HLCS(870,"B",LLNAME,0))
+18 ;IEN NOT FOUND - RETURN ERROR
IF 'IEN870
Begin DoDot:1
+19 SET ERROR="IEN OF RECORD TO BE UPDATED NOT SPECIFIED"
+20 SET RETURN=-1_"^"_ERROR
End DoDot:1
QUIT RETURN
+21 ;
+22 ; set v1.6 field values
+23 ;TCP/IP ADDRESS
SET DATA(400.01)=TCPADDR
+24 ;TCP/IP PORT
SET DATA(400.02)=TCPPORT
+25 ;AUTOSTART
SET DATA(4.5)=AUTO
+26 ;
+27 SET RETURN=$$UPD^DGENDBS(FILE,IEN870,.DATA,.ERROR)
+28 if ERROR'=""!(+RETURN=0)
SET RETURN=-1_"^"_ERROR
+29 ;
+30 QUIT RETURN
+31 ;
EDP(PNAME,DTXT) ;
+1 ;INPUT PNAME = Protocol Name
+2 ; DTXT = Disable Text
+3 ;
+4 ;OUTPUT IEN entry (#101) of Event Driver Protocol Success
+5 ; -1^Error Message Error
+6 ;
+7 ;PURPOSE Activate the Event Driver Protocol
+8 ;
+9 NEW DATA,FILE,DGENDA,RETURN,ERROR,DA,IEN101
+10 SET FILE=101
+11 ; If already exists then skip
+12 ;
+13 SET IEN101=$ORDER(^ORD(101,"B",PNAME,0))
+14 ;IEN NOT FOUND - RETURN ERROR
IF 'IEN101
Begin DoDot:1
+15 SET ERROR="IEN OF RECORD TO BE UPDATED NOT SPECIFIED"
+16 SET RETURN=-1_"^"_ERROR
End DoDot:1
QUIT RETURN
+17 ;
+18 ;DISABLE TEXT
SET DATA(2)=DTXT
+19 SET RETURN=$$UPD^DGENDBS(FILE,IEN101,.DATA,.ERROR)
+20 IF ERROR'=""!(+RETURN=0)
SET RETURN=-1_"^"_ERROR
GOTO EDPEXIT
+21 ;
EDPEXIT QUIT RETURN
+1 ;
+2 ;Clean up those message that have been placed into the EDB outbound
+3 ; logical link - LLEDBOUT erroneously. Delete them out of LLEDBOUT
+4 ; queue and place into general outbound queue.
+5 ;
CLEANUP NEW IEN870,VISN,M,IEN,QIEN,SLLN
+1 SET IEN870=$ORDER(^HLCS(870,"B","LLEDBOUT",0))
+2 IF 'IEN870
QUIT
+3 ;Nothing in queue
IF '$DATA(^HLMA("AC","O",IEN870))
QUIT
+4 WRITE !,"Requeue Z09 messages"
+5 SET IEN=0
+6 FOR
SET IEN=$ORDER(^HLMA("AC","O",IEN870,IEN))
if 'IEN
QUIT
Begin DoDot:1
+7 WRITE !?2,"Requeued Record# ",IEN
+8 LOCK +^HLMA(IEN):0
if '$TEST
QUIT
+9 DO REQUEUE(IEN)
+10 LOCK -^HLMA(IEN)
End DoDot:1
+11 WRITE !,"Requeue of records completed.",!
+12 QUIT
+13 ;
+14 ;Requeue the transaction into the IVM Billing Transmission (#301.61)
+15 ; file
+16 ;
REQUEUE(IEN773) NEW DFN,HLTCP,IEN30161,IEN772,PFLG,REC,SEG,SEQ,SID
+1 SET IEN772=+$PIECE($GET(^HLMA(IEN773,0)),"^")
+2 SET (PFLG,SEQ)=0
+3 FOR
SET SEQ=$ORDER(^HL(772,IEN772,"IN",SEQ))
if 'SEQ
QUIT
Begin DoDot:1
+4 IF $PIECE(^HL(772,IEN772,"IN",SEQ,0),"^")="PID"
Begin DoDot:2
+5 SET REC=$GET(^HL(772,IEN772,"IN",SEQ,0))
+6 SET DFN=+$PIECE($PIECE(REC,"^",4),"~")
+7 SET PFLG=1
End DoDot:2
+8 IF PFLG
IF $PIECE(^HL(772,IEN772,"IN",SEQ,0),"^")="FT1"
Begin DoDot:2
+9 SET REC=$GET(^HL(772,IEN772,"IN",SEQ,0))
+10 SET SID=$PIECE(REC,"^",8)
+11 SET IEN30161=$ORDER(^IVM(301.61,"B",SID,0))
+12 ;Requeue for IVM Billing
SET ^IVM(301.61,"ATR",DFN,IEN30161)=""
End DoDot:2
End DoDot:1
+13 ;PID Segment not found
IF 'PFLG
QUIT
+14 SET HLTCP=1
+15 ;Set 773 transaction to COMPLETE
DO STATUS^HLTF0(IEN773,3,,,1)
+16 QUIT
