Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ABSPOSC4

ABSPOSC4.m

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