ABSPOSC4 ; IHS/FCS/DRS - installation testing ;
;;1.0;PHARMACY POINT OF SALE;**48**;JUN 21, 2001;Build 38
Q
; Send the NEBRASKA MEDICAID test claim
; Special naming assumptions:
; 1. Insurer file has NEBRASKA MEDICAID
; 2. Formats file has NEBRASKA MEDICAID
; 3. Certification file has NEBRASKA MEDICAID TEST
;
THETEST ;EP - option
W !
W !
W "This is a test of the send-and-receive mechanism.",!
W "It sends a test claim to an insurer.",!
W "The claim should be rejected; it is only a test claim",!
W "and the data is made-up.",!
W !
W "This test should be done ONLY on a QUIET Point of Sale system.",!
W "There are theoretically possible conflicts with live processing,",!
W "which seem minor. Time has not permitted a comprehensive analysis.",!!
H 1
N INSNAME S INSNAME="NEBRASKA MEDICAID"
;W "Running the complete test, using ",INSNAME,!
;
; May need to uncomment the following line for some special cases.
;S DIALOUT=$O(^ABSP(9002313.55,"B","RESERVED - DO NOT USE",0))
;
N RESULT S RESULT=$$TEST1()
I RESULT D
. W "The test succeeded!",!
E D
. W "The test failed!",!
Q
TEST1(DIALOUT) ; returns true if success, false if failure
; given INSNAME is insurer name and also format name
; (this is usually not the case!)
N FMTNAME S FMTNAME=INSNAME
I '$G(DIALOUT) S DIALOUT=$$DEF5599^ABSPOSA I 'DIALOUT D Q 0
. W "Default dialout not set up yet?!",!
W "Using dial out ",$P(^ABSP(9002313.55,DIALOUT,0),U),!
N IEN31 S IEN31=$O(^ABSP(9002313.31,"B",INSNAME_" TEST",0))
I 'IEN31 W "Missing entry in 9002313.31.",! Q 0
N INSIEN S INSIEN=$$INSFIND
I 'INSIEN W "Missing ",INSNAME," in INSURER file",! Q 0
N IEN92 S IEN92=$O(^ABSPF(9002313.92,"B",INSNAME,0))
I 'IEN92 W "Missing format ",INSNAME," in INSURER file",! Q 0
; We need an ABSP INSURER entry.
; Possibly may be temporarily created just for the test.
N IEN4,IEN4ORIG S (IEN4,IEN4ORIG)=$$IEN4FIND
I 'IEN4 S IEN4=$$IEN4MAKE I 'IEN4 D Q 0
. W "Failed to create an ABSP INSURER entry for ",INSNAME,!
;
; Recap: we have the following:
; IEN4 = pointer to ^ABSPEI(
; IEN4ORIG = IEN4 if the entry already existed, false otherwise
; IEN92 = pointer to format in ^ABSPF(9002313.92,
; INSIEN = pointer to ^AUTNINS(
; IEN31 = pointer to test transaction data in ^ABSP(9002313.31,
; DIALOUT = pointer to ^ABSP(9002313.55,
;
; From this point - don't quit without going through the EXIT tag!!
S RESULT=0 ; reset RESULT=1 if you have success
;
I '$$SETUP31 D G EXIT ; set insurer pointer and switch
. W "Failed in SETUP31, trying to set some fields in 9002313.31.",!
;
; Build the claim packet
;
N IEN02 S IEN02=$$PACKET^ABSPOSC2(IEN31,DIALOUT)
I 'IEN02 D G EXIT
. W "Failed to create claim packet in 9002313.02",!
;
; Now send it
;
W "Sending the test claim..."
D RUNTEST^ABSPOSC3(DIALOUT,IEN02)
W " it's been handed to the background job.",!
;
; And finally, wait for the response.
;
D WAIT
I '$$RESPONSE D G EXIT
. W "No response received (yet)",!
. D LOG^ABSPOSC2
;
W !,"Yes, response received!",!
D PRINTRSP
S RESULT=1
;
EXIT I 'IEN4ORIG I '$$IEN4DEL D
. W "Failed to delete temporary ABSP INSURER entry for ",INSNAME,!
;
I $D(^ABSPECX("POS",DIALOUT,"C")) D ; kill claim if it's still around
. Q:'$$LLIST^ABSPOSAP
. K ^ABSPECX("POS",DIALOUT,"C")
. D ULLIST^ABSPOSAP
;
Q RESULT
WAIT ; wait for response
; either user's decision to stop or we've noticed response rec'd
W "Wait several seconds for the response - probably about 60 seconds",!
W " for a modem connection, or 30 seconds for the T1 line.",!
W "Type Q to Quit; L to view log file of transmission",!
W "Waiting for response to the test message..."
N QUIT,SEC S QUIT=0 F SEC=1:1 D Q:QUIT
. ;I SEC#3=0 W:$X>65 !?10 W "." ; another dot every three seconds
. N DIR,X,Y S DIR(0)="SAOM^L:L;Q:Q"
. S DIR("A")="Q to Quit; L to view Log: ",DIR("T")=5 D ^DIR
. I Y="" S QUIT=$$RESPONSE Q
. I Y="Q" S QUIT=1 Q
. I Y="L" D LOG^ABSPOSC2 Q
Q
RESPONSE() ; does IEN31 have a response for the generated claim?
; returns false if not, else returns IEN in 9002313.03
Q $O(^ABSPR("B",IEN02,0))
PRINTRSP N L S L=0
N DIC S DIC=9002313.03
N FLDS S FLDS="[CAPTIONED]"
N BY S BY=.01
N FR,TO S (FR,TO)=$P(^ABSPC(IEN02,0),U)
N DHD S DHD="@"
N IOP S IOP="HOME;80;999"
D EN1^DIP
Q
DEFDIAL() ; returns IEN to the default dial out
Q $O(^ABSP(9002313.55,"B","DEFAULT",0))
INSFIND() ; returns IEN to ^AUTNINS, false if not found
Q $O(^AUTNINS("B",INSNAME,0))
IEN4FIND() ; returns IEN to 9002313.4, false if not found
Q $O(^ABSPEI("B",$$INSFIND,0))
IEN4MAKE() ; given INSNAME and FMTNAME
; return TRUE if successfully created ; FALSE if not
N FDA,IENARR,MSG,FN,IENS,X S FN=9002313.4,IENS="+1,"
S X=$O(^AUTNINS("B",INSNAME,0))
I 'X W !,"Can't find ",INSNAME," in ^AUTNINS",! Q 0
S (FDA(9002313.4,IENS,.01),IENARR(1))=X
S X=$O(^ABSPF(9002313.92,"B",FMTNAME,0))
I 'X W !,"Missing ",FMTNAME," from ^ABSPF(9002313.92)",! Q 0
S FDA(9002313.4,IENS,100.01)=X
D UPDATE^DIE(,"FDA","IENARR","MSG")
I $D(MSG) D LOG^ABSPOSL2("IEN4MAKE^ABSPOSC4",.MSG) ; /IHS/OIT/RAM ; 12 JUN 17 ; AND LOG IT IF AN ERROR OCCURS.
I $D(MSG) D ZWRITE^ABSPOS("MSG") Q 0
Q $G(IENARR(1))
IEN4DEL() ; delete the ABSP INSURER entry (because we temporarily created it)
; returns TRUE if successfully deleted
N FDA,MSG
S FDA(9002313.4,IEN4_",",.01)=""
D FILE^DIE(,"FDA","MSG")
I $D(MSG) D LOG^ABSPOSL2("IEN4DEL^ABSPOSC4",.MSG) ; /IHS/OIT/RAM ; 12 JUN 17 ; AND LOG IT IF AN ERROR OCCURS.
Q '$D(^ABSPEI(IEN4))
SETUP31() ; fill in some fields in the 9002313.31 header ; ret true/false
N FDA,MSG,FN,IENS S FN=9002313.31,IENS=IEN31_","
S FDA(FN,IENS,.03)=""
S FDA(FN,IENS,.04)=IEN4
S FDA(FN,IENS,.05)=$$SWTYPE^ABSPOSCC(DIALOUT)
N F401,IENS401
S F401=$O(^ABSPF(9002313.91,"B",401,0))
S IENS401=$O(^ABSP(9002313.31,IEN31,1,"B",F401,0))
I 'IENS401 Q:'$$IMPOSS^ABSPOSUE("DB","TI","IENS401="_IENS401,,"SETUP31",$T(+0))
S IENS401=IENS401_","_IENS
S FDA(9002313.311,IENS401,.02)=DT
N F414,IENS414
S F414=$O(^ABSPF(9002313.91,"B",414,0))
S IENS414=$O(^ABSP(9002313.31,IEN31,2,1,1,"B",F414,0))
S IENS414=IENS414_",1,"_IENS
S FDA(9002313.3121,IENS414,.02)=DT
D FILE^DIE(,"FDA","MSG")
I $D(MSG) D LOG^ABSPOSL2("SETUP31^ABSPOSC4",.MSG) ; /IHS/OIT/RAM ; 12 JUN 17 ; AND LOG IT IF AN ERROR OCCURS.
Q '$D(MSG)
ABSPOSC4 ; IHS/FCS/DRS - installation testing ;
+1 ;;1.0;PHARMACY POINT OF SALE;**48**;JUN 21, 2001;Build 38
+2 QUIT
+3 ; Send the NEBRASKA MEDICAID test claim
+4 ; Special naming assumptions:
+5 ; 1. Insurer file has NEBRASKA MEDICAID
+6 ; 2. Formats file has NEBRASKA MEDICAID
+7 ; 3. Certification file has NEBRASKA MEDICAID TEST
+8 ;
THETEST ;EP - option
+1 WRITE !
+2 WRITE !
+3 WRITE "This is a test of the send-and-receive mechanism.",!
+4 WRITE "It sends a test claim to an insurer.",!
+5 WRITE "The claim should be rejected; it is only a test claim",!
+6 WRITE "and the data is made-up.",!
+7 WRITE !
+8 WRITE "This test should be done ONLY on a QUIET Point of Sale system.",!
+9 WRITE "There are theoretically possible conflicts with live processing,",!
+10 WRITE "which seem minor. Time has not permitted a comprehensive analysis.",!!
+11 HANG 1
+12 NEW INSNAME
SET INSNAME="NEBRASKA MEDICAID"
+13 ;W "Running the complete test, using ",INSNAME,!
+14 ;
+15 ; May need to uncomment the following line for some special cases.
+16 ;S DIALOUT=$O(^ABSP(9002313.55,"B","RESERVED - DO NOT USE",0))
+17 ;
+18 NEW RESULT
SET RESULT=$$TEST1()
+19 IF RESULT
Begin DoDot:1
+20 WRITE "The test succeeded!",!
End DoDot:1
+21 IF '$TEST
Begin DoDot:1
+22 WRITE "The test failed!",!
End DoDot:1
+23 QUIT
TEST1(DIALOUT) ; returns true if success, false if failure
+1 ; given INSNAME is insurer name and also format name
+2 ; (this is usually not the case!)
+3 NEW FMTNAME
SET FMTNAME=INSNAME
+4 IF '$GET(DIALOUT)
SET DIALOUT=$$DEF5599^ABSPOSA
IF 'DIALOUT
Begin DoDot:1
+5 WRITE "Default dialout not set up yet?!",!
End DoDot:1
QUIT 0
+6 WRITE "Using dial out ",$PIECE(^ABSP(9002313.55,DIALOUT,0),U),!
+7 NEW IEN31
SET IEN31=$ORDER(^ABSP(9002313.31,"B",INSNAME_" TEST",0))
+8 IF 'IEN31
WRITE "Missing entry in 9002313.31.",!
QUIT 0
+9 NEW INSIEN
SET INSIEN=$$INSFIND
+10 IF 'INSIEN
WRITE "Missing ",INSNAME," in INSURER file",!
QUIT 0
+11 NEW IEN92
SET IEN92=$ORDER(^ABSPF(9002313.92,"B",INSNAME,0))
+12 IF 'IEN92
WRITE "Missing format ",INSNAME," in INSURER file",!
QUIT 0
+13 ; We need an ABSP INSURER entry.
+14 ; Possibly may be temporarily created just for the test.
+15 NEW IEN4,IEN4ORIG
SET (IEN4,IEN4ORIG)=$$IEN4FIND
+16 IF 'IEN4
SET IEN4=$$IEN4MAKE
IF 'IEN4
Begin DoDot:1
+17 WRITE "Failed to create an ABSP INSURER entry for ",INSNAME,!
End DoDot:1
QUIT 0
+18 ;
+19 ; Recap: we have the following:
+20 ; IEN4 = pointer to ^ABSPEI(
+21 ; IEN4ORIG = IEN4 if the entry already existed, false otherwise
+22 ; IEN92 = pointer to format in ^ABSPF(9002313.92,
+23 ; INSIEN = pointer to ^AUTNINS(
+24 ; IEN31 = pointer to test transaction data in ^ABSP(9002313.31,
+25 ; DIALOUT = pointer to ^ABSP(9002313.55,
+26 ;
+27 ; From this point - don't quit without going through the EXIT tag!!
+28 ; reset RESULT=1 if you have success
SET RESULT=0
+29 ;
+30 ; set insurer pointer and switch
IF '$$SETUP31
Begin DoDot:1
+31 WRITE "Failed in SETUP31, trying to set some fields in 9002313.31.",!
End DoDot:1
GOTO EXIT
+32 ;
+33 ; Build the claim packet
+34 ;
+35 NEW IEN02
SET IEN02=$$PACKET^ABSPOSC2(IEN31,DIALOUT)
+36 IF 'IEN02
Begin DoDot:1
+37 WRITE "Failed to create claim packet in 9002313.02",!
End DoDot:1
GOTO EXIT
+38 ;
+39 ; Now send it
+40 ;
+41 WRITE "Sending the test claim..."
+42 DO RUNTEST^ABSPOSC3(DIALOUT,IEN02)
+43 WRITE " it's been handed to the background job.",!
+44 ;
+45 ; And finally, wait for the response.
+46 ;
+47 DO WAIT
+48 IF '$$RESPONSE
Begin DoDot:1
+49 WRITE "No response received (yet)",!
+50 DO LOG^ABSPOSC2
End DoDot:1
GOTO EXIT
+51 ;
+52 WRITE !,"Yes, response received!",!
+53 DO PRINTRSP
+54 SET RESULT=1
+55 ;
EXIT IF 'IEN4ORIG
IF '$$IEN4DEL
Begin DoDot:1
+1 WRITE "Failed to delete temporary ABSP INSURER entry for ",INSNAME,!
End DoDot:1
+2 ;
+3 ; kill claim if it's still around
IF $DATA(^ABSPECX("POS",DIALOUT,"C"))
Begin DoDot:1
+4 IF '$$LLIST^ABSPOSAP
QUIT
+5 KILL ^ABSPECX("POS",DIALOUT,"C")
+6 DO ULLIST^ABSPOSAP
End DoDot:1
+7 ;
+8 QUIT RESULT
WAIT ; wait for response
+1 ; either user's decision to stop or we've noticed response rec'd
+2 WRITE "Wait several seconds for the response - probably about 60 seconds",!
+3 WRITE " for a modem connection, or 30 seconds for the T1 line.",!
+4 WRITE "Type Q to Quit; L to view log file of transmission",!
+5 WRITE "Waiting for response to the test message..."
+6 NEW QUIT,SEC
SET QUIT=0
FOR SEC=1:1
Begin DoDot:1
+7 ;I SEC#3=0 W:$X>65 !?10 W "." ; another dot every three seconds
+8 NEW DIR,X,Y
SET DIR(0)="SAOM^L:L;Q:Q"
+9 SET DIR("A")="Q to Quit; L to view Log: "
SET DIR("T")=5
DO ^DIR
+10 IF Y=""
SET QUIT=$$RESPONSE
QUIT
+11 IF Y="Q"
SET QUIT=1
QUIT
+12 IF Y="L"
DO LOG^ABSPOSC2
QUIT
End DoDot:1
IF QUIT
QUIT
+13 QUIT
RESPONSE() ; does IEN31 have a response for the generated claim?
+1 ; returns false if not, else returns IEN in 9002313.03
+2 QUIT $ORDER(^ABSPR("B",IEN02,0))
PRINTRSP NEW L
SET L=0
+1 NEW DIC
SET DIC=9002313.03
+2 NEW FLDS
SET FLDS="[CAPTIONED]"
+3 NEW BY
SET BY=.01
+4 NEW FR,TO
SET (FR,TO)=$PIECE(^ABSPC(IEN02,0),U)
+5 NEW DHD
SET DHD="@"
+6 NEW IOP
SET IOP="HOME;80;999"
+7 DO EN1^DIP
+8 QUIT
DEFDIAL() ; returns IEN to the default dial out
+1 QUIT $ORDER(^ABSP(9002313.55,"B","DEFAULT",0))
INSFIND() ; returns IEN to ^AUTNINS, false if not found
+1 QUIT $ORDER(^AUTNINS("B",INSNAME,0))
IEN4FIND() ; returns IEN to 9002313.4, false if not found
+1 QUIT $ORDER(^ABSPEI("B",$$INSFIND,0))
IEN4MAKE() ; given INSNAME and FMTNAME
+1 ; return TRUE if successfully created ; FALSE if not
+2 NEW FDA,IENARR,MSG,FN,IENS,X
SET FN=9002313.4
SET IENS="+1,"
+3 SET X=$ORDER(^AUTNINS("B",INSNAME,0))
+4 IF 'X
WRITE !,"Can't find ",INSNAME," in ^AUTNINS",!
QUIT 0
+5 SET (FDA(9002313.4,IENS,.01),IENARR(1))=X
+6 SET X=$ORDER(^ABSPF(9002313.92,"B",FMTNAME,0))
+7 IF 'X
WRITE !,"Missing ",FMTNAME," from ^ABSPF(9002313.92)",!
QUIT 0
+8 SET FDA(9002313.4,IENS,100.01)=X
+9 DO UPDATE^DIE(,"FDA","IENARR","MSG")
+10 ; /IHS/OIT/RAM ; 12 JUN 17 ; AND LOG IT IF AN ERROR OCCURS.
IF $DATA(MSG)
DO LOG^ABSPOSL2("IEN4MAKE^ABSPOSC4",.MSG)
+11 IF $DATA(MSG)
DO ZWRITE^ABSPOS("MSG")
QUIT 0
+12 QUIT $GET(IENARR(1))
IEN4DEL() ; delete the ABSP INSURER entry (because we temporarily created it)
+1 ; returns TRUE if successfully deleted
+2 NEW FDA,MSG
+3 SET FDA(9002313.4,IEN4_",",.01)=""
+4 DO FILE^DIE(,"FDA","MSG")
+5 ; /IHS/OIT/RAM ; 12 JUN 17 ; AND LOG IT IF AN ERROR OCCURS.
IF $DATA(MSG)
DO LOG^ABSPOSL2("IEN4DEL^ABSPOSC4",.MSG)
+6 QUIT '$DATA(^ABSPEI(IEN4))
SETUP31() ; fill in some fields in the 9002313.31 header ; ret true/false
+1 NEW FDA,MSG,FN,IENS
SET FN=9002313.31
SET IENS=IEN31_","
+2 SET FDA(FN,IENS,.03)=""
+3 SET FDA(FN,IENS,.04)=IEN4
+4 SET FDA(FN,IENS,.05)=$$SWTYPE^ABSPOSCC(DIALOUT)
+5 NEW F401,IENS401
+6 SET F401=$ORDER(^ABSPF(9002313.91,"B",401,0))
+7 SET IENS401=$ORDER(^ABSP(9002313.31,IEN31,1,"B",F401,0))
+8 IF 'IENS401
IF '$$IMPOSS^ABSPOSUE("DB","TI","IENS401="_IENS401,,"SETUP31",$TEXT(+0))
QUIT
+9 SET IENS401=IENS401_","_IENS
+10 SET FDA(9002313.311,IENS401,.02)=DT
+11 NEW F414,IENS414
+12 SET F414=$ORDER(^ABSPF(9002313.91,"B",414,0))
+13 SET IENS414=$ORDER(^ABSP(9002313.31,IEN31,2,1,1,"B",F414,0))
+14 SET IENS414=IENS414_",1,"_IENS
+15 SET FDA(9002313.3121,IENS414,.02)=DT
+16 DO FILE^DIE(,"FDA","MSG")
+17 ; /IHS/OIT/RAM ; 12 JUN 17 ; AND LOG IT IF AN ERROR OCCURS.
IF $DATA(MSG)
DO LOG^ABSPOSL2("SETUP31^ABSPOSC4",.MSG)
+18 QUIT '$DATA(MSG)
