IVM2069P ;ALB/EJG - Patch Post-Install functions IVM*2*69;11/27/2002; 9/20/01 4:16pm
;;2.0;INCOME VERIFICATION;**69**;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
Q:$$SETLL16(STATION,.RLLN,.SLLN)
Q:$$SETAPP(STATION,.AN)
D PROTOCOL(STATION,RLLN,SLLN,.AN)
;
;Update #301.93 with new Closure Reasons
;
CLOSREA S FILE=301.93
S ERROR=""
K DATA
I '$D(^IVM(301.93,"B","CONVERTED")) D Q:ERROR'=""!(+RET=0)
. S DATA(.01)="CONVERTED"
. S RET=$$ADD^DGENDBS(FILE,"",.DATA,.ERROR)
. I ERROR'=""!(+RET=0) D
. . S RET=-1_"^"_ERROR
. . D ERROR(RET,"Updating #301.93")
I '$D(^IVM(301.93,"B","NOT CONVERTED")) D Q:ERROR'=""!(+RET=0)
. S DATA(.01)="NOT CONVERTED"
. S RET=$$ADD^DGENDBS(FILE,"",.DATA,.ERROR)
. I ERROR'=""!(+RET=0) D
. . S RET=-1_"^"_ERROR
. . D ERROR(RET,"Updating #301.93")
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
;
S PORT=7788 ;e*Gate Port#
;
; Sending Logical Link
S SLLN="LLEDBOUT"
S ADDR="127.0.0.1" ;e*Gate development
;S ADDR="127.0.0.1" ;e*Gate production
S RET=$$LL16^IVM2069Q(SLLN,"TCP","NC",10,ADDR,PORT,"C","N","")
I +RET<0 D ERROR(RET,"Edb Send Link:"_SLLN) Q 1
;
RLL ; Receiving Logical Link
S RLLN="LLEDBIN"
S ADDR=""
S PORT="" ;5000 ;all stations production
S RET=$$LL16^IVM2069Q(RLLN,"TCP","MS",10,ADDR,PORT,"M","N","")
I +RET<0 D ERROR(RET,"Edb Receive Link:"_RLLN) Q 1
LL16EXIT Q STOP
;
;
SETAPP(STATION,AN) ;
;INPUT STATION = Station #
; AN = Array containing all the Application Names
;
;OUTPUT 0 : Success, 1 : Error
;
;PURPOSE Create the sending and receiving application definitions.
;
N RECVAPP,SENDAPP
S AN("S")="EAS EDB"
S SENDAPP=$$APP^IVM2069Q(AN("S"),"a",STATION,"USA")
I +SENDAPP<0 D ERROR(SENDAPP,"Sending App:"_AN("S")) G APPEXIT
;
ANR S AN("R")="EDB eGate"
S RECVAPP=$$APP^IVM2069Q(AN("R"),"a",200,"USA")
I +RECVAPP<0 D ERROR(RECVAPP,"Receiving App:"_AN("R"))
APPEXIT 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 Using the table in line label PROTDAT create 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
;S N1="VAMC "_STATION,V="2.3.1"
S N1="",V="2.3.1"
;
S LNCNT=1
F S LINE=$T(PROTDAT+LNCNT) Q:$P(LINE,";",3)="END" D Q:STOP
. K D,RESULT
. F N=3:1 Q:$P(LINE,";",N)="LEND" S D(N)=$$V($P(LINE,";",N))
. S NAM=D(3)_D(4)_D(5)
. D:NAM["CLIENT"
. . S SIEN=$$SP^IVM2069Q(NAM,D(6),D(7),D(8),D(9),D(10))
. . I +SIEN<0 D ERROR(SIEN,"Subscriber:"_NAM)
. D:NAM["SERVER"
. . N TMPNAM,ITEMTXT
. . S TMPNAM=D(6)_D(7)_$P(NAM,"SERVER ",2)
. . S ITEMTXT=$$GETIT(TMPNAM)
. . S RESULT=$$EDP^IVM2069Q(NAM,D(6),D(7),D(8),D(9),D(10),D(11),D(12),ITEMTXT)
. . I +RESULT<0 D ERROR(RESULT,"Event Driver:"_NAM)
. S LNCNT=LNCNT+1
K D
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
;
V(VALUE) ;FUNCTION: If variable then pass back value of it.
;
I $E(VALUE)="@" Q @($E(VALUE,2,$L(VALUE)))
Q VALUE
;
GETIT(N) ;FUNCTION: Given Message Type and Event Type return the
; Transmission Description.
Q:N="ORUZ06" "IVM Case Status/Unsolicited HEC/Edb to VAMC"
Q:N="ORUZ09" "IVM BILLING/COLLECTION/Unsolicited VAMC to HEC/Edb"
Q ""
;
PROTDAT ;;VAMC SIDE PROTOCOLS
;;@N1;;EAS EDB ORU-Z06 CLIENT;@SLLN;@AN("S");ACK;;D ORU^EASPREC2;LEND
;;@N1;;EAS EDB ORU-Z06 SERVER;ORU;Z06;@V;@AN("R");;@SIEN;Edb-to-Site Messaging Inactive;LEND
;;@N1;;EAS EDB ORU-Z09 CLIENT;@SLLN;@AN("R");ACK;;;LEND
;;@N1;;EAS EDB ORU-Z09 SERVER;ORU;Z09;@V;@AN("S");D ACK^IVMPREC1;@SIEN;Site-to-Edb Messaging Inactive;LEND
;;END
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIVM2069P 4904 printed Nov 22, 2024@17:10:39 Page 2
IVM2069P ;ALB/EJG - Patch Post-Install functions IVM*2*69;11/27/2002; 9/20/01 4:16pm
+1 ;;2.0;INCOME VERIFICATION;**69**;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 if $$SETLL16(STATION,.RLLN,.SLLN)
QUIT
+9 if $$SETAPP(STATION,.AN)
QUIT
+10 DO PROTOCOL(STATION,RLLN,SLLN,.AN)
+11 ;
+12 ;Update #301.93 with new Closure Reasons
+13 ;
CLOSREA SET FILE=301.93
+1 SET ERROR=""
+2 KILL DATA
+3 IF '$DATA(^IVM(301.93,"B","CONVERTED"))
Begin DoDot:1
+4 SET DATA(.01)="CONVERTED"
+5 SET RET=$$ADD^DGENDBS(FILE,"",.DATA,.ERROR)
+6 IF ERROR'=""!(+RET=0)
Begin DoDot:2
+7 SET RET=-1_"^"_ERROR
+8 DO ERROR(RET,"Updating #301.93")
End DoDot:2
End DoDot:1
if ERROR'=""!(+RET=0)
QUIT
+9 IF '$DATA(^IVM(301.93,"B","NOT CONVERTED"))
Begin DoDot:1
+10 SET DATA(.01)="NOT CONVERTED"
+11 SET RET=$$ADD^DGENDBS(FILE,"",.DATA,.ERROR)
+12 IF ERROR'=""!(+RET=0)
Begin DoDot:2
+13 SET RET=-1_"^"_ERROR
+14 DO ERROR(RET,"Updating #301.93")
End DoDot:2
End DoDot:1
if ERROR'=""!(+RET=0)
QUIT
+15 QUIT
+16 ;
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 ;e*Gate Port#
SET PORT=7788
+12 ;
+13 ; Sending Logical Link
+14 SET SLLN="LLEDBOUT"
+15 ;e*Gate development
SET ADDR="127.0.0.1"
+16 ;S ADDR="127.0.0.1" ;e*Gate production
+17 SET RET=$$LL16^IVM2069Q(SLLN,"TCP","NC",10,ADDR,PORT,"C","N","")
+18 IF +RET<0
DO ERROR(RET,"Edb Send Link:"_SLLN)
QUIT 1
+19 ;
RLL ; Receiving Logical Link
+1 SET RLLN="LLEDBIN"
+2 SET ADDR=""
+3 ;5000 ;all stations production
SET PORT=""
+4 SET RET=$$LL16^IVM2069Q(RLLN,"TCP","MS",10,ADDR,PORT,"M","N","")
+5 IF +RET<0
DO ERROR(RET,"Edb Receive Link:"_RLLN)
QUIT 1
LL16EXIT QUIT STOP
+1 ;
+2 ;
SETAPP(STATION,AN) ;
+1 ;INPUT STATION = Station #
+2 ; AN = Array containing all the Application Names
+3 ;
+4 ;OUTPUT 0 : Success, 1 : Error
+5 ;
+6 ;PURPOSE Create the sending and receiving application definitions.
+7 ;
+8 NEW RECVAPP,SENDAPP
+9 SET AN("S")="EAS EDB"
+10 SET SENDAPP=$$APP^IVM2069Q(AN("S"),"a",STATION,"USA")
+11 IF +SENDAPP<0
DO ERROR(SENDAPP,"Sending App:"_AN("S"))
GOTO APPEXIT
+12 ;
ANR SET AN("R")="EDB eGate"
+1 SET RECVAPP=$$APP^IVM2069Q(AN("R"),"a",200,"USA")
+2 IF +RECVAPP<0
DO ERROR(RECVAPP,"Receiving App:"_AN("R"))
APPEXIT 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 Using the table in line label PROTDAT create the
+9 ; protocols (Subscriber and Event Driver) for the
+10 ; Edb/e*Gate TCP/IP interfaces
+11 ;
+12 NEW RESULT,SIEN,DUZ,V,N,N1,LNCNT,LINE,PROTRET,NAM
+13 ;S N1="VAMC "_STATION,V="2.3.1"
+14 SET N1=""
SET V="2.3.1"
+15 ;
+16 SET LNCNT=1
+17 FOR
SET LINE=$TEXT(PROTDAT+LNCNT)
if $PIECE(LINE,";",3)="END"
QUIT
Begin DoDot:1
+18 KILL D,RESULT
+19 FOR N=3:1
if $PIECE(LINE,";",N)="LEND"
QUIT
SET D(N)=$$V($PIECE(LINE,";",N))
+20 SET NAM=D(3)_D(4)_D(5)
+21 if NAM["CLIENT"
Begin DoDot:2
+22 SET SIEN=$$SP^IVM2069Q(NAM,D(6),D(7),D(8),D(9),D(10))
+23 IF +SIEN<0
DO ERROR(SIEN,"Subscriber:"_NAM)
End DoDot:2
+24 if NAM["SERVER"
Begin DoDot:2
+25 NEW TMPNAM,ITEMTXT
+26 SET TMPNAM=D(6)_D(7)_$PIECE(NAM,"SERVER ",2)
+27 SET ITEMTXT=$$GETIT(TMPNAM)
+28 SET RESULT=$$EDP^IVM2069Q(NAM,D(6),D(7),D(8),D(9),D(10),D(11),D(12),ITEMTXT)
+29 IF +RESULT<0
DO ERROR(RESULT,"Event Driver:"_NAM)
End DoDot:2
+30 SET LNCNT=LNCNT+1
End DoDot:1
if STOP
QUIT
+31 KILL D
+32 QUIT
+33 ;
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 ;
V(VALUE) ;FUNCTION: If variable then pass back value of it.
+1 ;
+2 IF $EXTRACT(VALUE)="@"
QUIT @($EXTRACT(VALUE,2,$LENGTH(VALUE)))
+3 QUIT VALUE
+4 ;
GETIT(N) ;FUNCTION: Given Message Type and Event Type return the
+1 ; Transmission Description.
+2 if N="ORUZ06"
QUIT "IVM Case Status/Unsolicited HEC/Edb to VAMC"
+3 if N="ORUZ09"
QUIT "IVM BILLING/COLLECTION/Unsolicited VAMC to HEC/Edb"
+4 QUIT ""
+5 ;
PROTDAT ;;VAMC SIDE PROTOCOLS
+1 ;;@N1;;EAS EDB ORU-Z06 CLIENT;@SLLN;@AN("S");ACK;;D ORU^EASPREC2;LEND
+2 ;;@N1;;EAS EDB ORU-Z06 SERVER;ORU;Z06;@V;@AN("R");;@SIEN;Edb-to-Site Messaging Inactive;LEND
+3 ;;@N1;;EAS EDB ORU-Z09 CLIENT;@SLLN;@AN("R");ACK;;;LEND
+4 ;;@N1;;EAS EDB ORU-Z09 SERVER;ORU;Z09;@V;@AN("S");D ACK^IVMPREC1;@SIEN;Site-to-Edb Messaging Inactive;LEND
+5 ;;END
+6 ;
