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