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

ABSPOSQL.m

Go to the documentation of this file. 
  1. ABSPOSQL ; IHS/FCS/DRS - Process responses ;   [ 10/07/2002  8:20 AM ]
  1.  ;;1.0;PHARMACY POINT OF SALE;**3,29,31,32,48**;JUN 21, 2001;Build 38
  1.  ;
  1.  ;-----------------------------------------------------
  1.  ;IHS/SD/lwj 10/07/02 NCPDP 5.1 changes
  1.  ; The reversal claim now has a transaction code of "B2" instead of 
  1.  ; 11.  Needed to adjust the ISREVERS routine to account for the 
  1.  ; difference.  Also adjusted the RESP1 routine to check the
  1.  ; additional message field (526) since not all processors will use
  1.  ; the 504 message field in 5.1.
  1.  ;
  1.  ;-----------------------------------------------------
  1.  Q
  1.  ;
  1.  ; Subroutines from ABSPOSQ4 - the main line of processing is in here.
  1.  ; The utility subroutines remain in ABSPOSQ4.
  1.  ;
  1.  ;  RESPONSE(DIALOUT)
  1.  ;     Processes all response packets for this DIALOUT
  1.  ;     Creates 9002313.03 response record
  1.  ;     At this point, you are guaranteed to be the only job
  1.  ;     processing responses for this DIALOUT - you have a LOCK on
  1.  ;     that privilege, set up in ABSPOSQ4.  But the old LOCK logic
  1.  ;     is retained in here, in case that ABSPOSQ4 restriction is
  1.  ;     ever removed.
  1.  ;  ONE(CLAIMIEN,RESPIEN)
  1.  ;     Process the 9002313.03 RESPIEN for the 9002313.02 CLAIMIEN
  1.  ;     Loops through all 9002313.59's represented in the CLAIMIEN
  1.  ;  ONE1(IEN59)
  1.  ;     Processing the 9002313.03 RESPIEN for this one IEN59
  1.  ;     It's just a tiny wrapper for RESP1 to save,set,restore logging
  1.  ;  RESP1
  1.  ;     The real work of response handling for one IEN59 is in here
  1.  ;
  1. RESPONSE(DIALOUT) ;EP - ABSPOSQ4
  1.  ;
  1.  ; Currently, the caller from ABSPOSQ4 will already have the
  1.  ; lock on ^TMP("ABSPOSQ4",DIALOUT)
  1.  ; This routine tries to get L +^ABSPECX("POS",DIALOUT,"R")
  1.  ; and then L +^ABSPECX("POS",DIALOUT,"R",CLAIMIEN)
  1.  ; All of this locking could be greatly simplified, it seems.
  1.  ; 
  1.  N CLAIMIEN,RESPIEN,RESPREC,CLAIMID,DIC,X,Y
  1.  S CLAIMIEN=""
  1.  F  D  Q:CLAIMIEN=""
  1.  . I '$$LLIST S CLAIMIEN="" Q  ; Lock the whole list of responses
  1.  . ;D LOG^ABSPOSL("PRAscii1^"_$T(+0)_" 1. with CLAIMIEN="_CLAIMIEN)
  1.  . S CLAIMIEN=$O(^ABSPECX("POS",DIALOUT,"R",CLAIMIEN))
  1.  . ;D LOG^ABSPOSL("PRAscii1^"_$T(+0)_" 2. with CLAIMIEN="_CLAIMIEN)
  1.  . I CLAIMIEN="" D ULLIST Q
  1.  . ; lock the individual response and unlock the list (useless oper?)
  1.  . F  Q:$$LRESP  Q:'$$IMPOSS^ABSPOSUE("L","RI","Locking response for CLAIMIEN="_CLAIMIEN,,"RESPONSE",$T(+0))
  1.  . D ULLIST ; unlock the list
  1.  . ;
  1.  . ;Assemble RESPREC from scratch global
  1.  . S RESPREC=""
  1.  . N I F I=1:1:^ABSPECX("POS",DIALOUT,"R",CLAIMIEN,0) D
  1.  . . S RESPREC=RESPREC_^ABSPECX("POS",DIALOUT,"R",CLAIMIEN,I)
  1.  . S RESPREC=$P(RESPREC,$C(3))
  1.  . I RESPREC="" D  Q  ; null response?  should be impossible,
  1.  . . ; but we saw it once at Parker.
  1.  . . D LOG^ABSPOSL($T(+0)_" - ??? Null response to CLAIMIEN "_CLAIMIEN)
  1.  . . D KILLRESP
  1.  . ;
  1.  . S CLAIMID=$P($G(^ABSPC(CLAIMIEN,0)),U,1)
  1.  . I CLAIMID="" D  Q  ; impossible?
  1.  . . D LOG^ABSPOSL($T(+0)_" - ??? CLAIMID is missing from "_CLAIMIEN)
  1.  . . D KILLRESP
  1.  . ;
  1.  . ;Create Claim Response Record (9002313.03)
  1.  . F  D  Q:RESPIEN'<1  Q:$$IMPOSS^ABSPOSUE("FM","TI","^DIC failed to create new ^ABSPR record for CLAIMID="_CLAIMID,,,$T(+0))
  1.  . . N X,DLAYGO,DIC,Y S X=""""_CLAIMID_""""
  1.  . . S DIC="^ABSPR(",DIC(0)="LXZ",DLAYGO=9002313.03 D ^DIC
  1.  . . S RESPIEN=+Y
  1.  . ;
  1.  . D LOG^ABSPOSL($T(+0)_" - Claim "_CLAIMIEN_" got Response "_RESPIEN)
  1.  . ;
  1.  . N STAMP S STAMP=$$NOWFM^ABSPOSU1()
  1.  . ;
  1.  . ;Set Date/Time Response Received field, set cross-reference
  1.  . S $P(^ABSPR(RESPIEN,0),U,2)=STAMP
  1.  . S ^ABSPR("AE",STAMP,RESPIEN)=""
  1.  . ;
  1.  . ;Set Transmitted On field, set cross-reference
  1.  . S $P(^ABSPC(CLAIMIEN,0),U,5)=STAMP
  1.  . S ^ABSPC("AE",STAMP,CLAIMIEN)=""
  1.  . ;
  1.  . ;Turn off transmit flag, reset cross-reference
  1.  . S $P(^ABSPC(CLAIMIEN,0),U,4)=0
  1.  . K ^ABSPC("AD",2,CLAIMIEN) ; 2 (POS) not 1 (old batch)
  1.  . S ^ABSPC("AD",0,CLAIMIEN)=""
  1.  . ;
  1.  . ;Parse and File Ascii Response record in Claim Response File
  1.  . D PARSE^ABSPECA4(RESPREC,RESPIEN)
  1.  .    ;
  1.  .    ;  and the right place to process POS responses is here!!!!
  1.  .    ;
  1.  . ; (there was some problem with this slot stacking mechanism?)
  1.  . ;N OLDSLOT S OLDSLOT=$$GETSLOT^ABSPOSL ; remember current slot
  1.  . D ONE(CLAIMIEN,RESPIEN)
  1.  . ;D SETSLOT^ABSPOSL(OLDSLOT) ; restore the old one
  1.  . ;
  1.  . D KILLRESP ; kill the scratch response
  1.  . ; Save a copy of the received packet, too
  1.  . N WP,I,ZERR F I=1:100:$L(RESPREC) S WP(I/100+1,0)=$E(RESPREC,I,I+99)
  1.  . D WP^DIE(9002313.03,RESPIEN_",",9999,"","WP","ZERR") ; /IHS/OIT/RAM ; 12 JUN 17 ; UPDATE DBS CALL TO ALLOW FOR ERROR RETURN.
  1.  . I $D(ZERR) D LOG^ABSPOSL2("RESPONSE+72^ABSPOSQL",.ZERR) ; /IHS/OIT/RAM ; 12 JUN 17 ; AND LOG IT IF AN ERROR OCCURS.
  1.  . D ULRESP ; unlock the response
  1.  . Q
  1.  Q
  1.  ;IHS/SD/lwj 10/07/02 NCPDP 5.1 changes - for reversals we need
  1.  ; to account for a transaction code of 11 for 3.2 claims and
  1.  ; B2 for 5.1 claims.  The next line was remarked out and 
  1.  ; replaced with the 6 lines following it.
  1.  ;ISREVERS(X)        Q $P(^ABSPC(X,100),U,3)=11 ; trans.code REVERSAL
  1. ISREVERS(X)        ; trans.code REVERSAL
  1.  ;
  1.  N REVS
  1.  S REVS=0
  1.  S:($P(^ABSPC(X,100),U,3)=11)!($P(^ABSPC(X,100),U,3)="B2") REVS=1
  1.  Q REVS
  1.  ;
  1.  ;IHS/SD/lwj 10/07/02 end changes to ISREVERS
  1.  ;
  1. ONE(CLAIMIEN,RESPIEN)        ;
  1.  ; Both the 9002313.02 and 9002313.03 are correct and complete
  1.  ; Now update all of the prescription records affected by them.
  1.  ; Loop:  for each prescription represented in the original claim:
  1.  N OLDSLOT S OLDSLOT=$$GETSLOT^ABSPOSL
  1.  N ISREVERS S ISREVERS=$$ISREVERS(CLAIMIEN)
  1.  N X S X="RESPONSE -"
  1.  I ISREVERS S X=X_" REVERSAL -"
  1.  S X=X_" Response #"_RESPIEN
  1.  S X=X_" for Claim #"_CLAIMIEN D LOG^ABSPOSL(X)
  1.  N INDEX S INDEX=$S(ISREVERS:"AER",1:"AE")
  1.  N IEN59 S IEN59=0
  1.  F  S IEN59=$O(^ABSPT(INDEX,CLAIMIEN,IEN59)) Q:IEN59=""  D
  1.  . D ONE1(IEN59)
  1.  Q
  1. ONE1(ABSBRXI) ; ABSBRXI would more properly be called IEN59
  1.  D SETSLOT^ABSPOSL(OLDSLOT)
  1.  D LOG^ABSPOSL("RESPONSE - for ^ABSPT("_ABSBRXI_")")
  1.  D RESP1
  1.  D SETSLOT^ABSPOSL(OLDSLOT) ; because RESP1 changed it, probably
  1.  Q
  1.  ;----------------------------------------------------------------------
  1.  ;Process ASCII Claim Response Records:
  1.  ;
  1.  ;     1.  Loop through ^ABSPECX("POS",DIALOUT,$J,"R",CLAIMIEN) 
  1.  ;         transmission scratch global
  1.  ;     2.  Assemble ASCII Claim Response Records
  1.  ;     3.  Create new records in Claim Response File (9002313.03)
  1.  ;     4.  Parse ASCII Claim Response Records then file in
  1.  ;         Claim Response File (9002313.03)
  1.  ;----------------------------------------------------------------------
  1.  ;
  1. LLIST() L +^ABSPECX("POS",DIALOUT,"R"):60 Q $T
  1. ULLIST L -^ABSPECX("POS",DIALOUT,"R") Q
  1. LRESP() L +^ABSPECX("POS",DIALOUT,"R",CLAIMIEN):60 Q $T
  1. ULRESP L -^ABSPECX("POS",DIALOUT,"R",CLAIMIEN) Q
  1. KILLRESP K ^ABSPECX("POS",DIALOUT,"R",CLAIMIEN) Q
  1.  ;
  1. RESP1 ; called from  ONE1
  1.  ; ABSBRXI would more properly be called IEN59
  1.  N ERROR
  1.  S ERROR=0  ;IHS/OIT/SCR 050409
  1.  D SETSLOT^ABSPOSL(ABSBRXI) ;  point to slot for logging
  1.  N REVERSAL S REVERSAL=$G(^ABSPT(ABSBRXI,4))>0
  1.  D  ; store pointer to response
  1.  . N DIE,DA,DR S DIE=9002313.59,DA=ABSBRXI
  1.  . S DR=$S(REVERSAL:402,1:4)_"////"_RESPIEN
  1.  . D ^DIE
  1.  D SETSTAT^ABSPOSU(90) ; "Processing response"
  1.  ;D LOG^ABSPOSL("RESPONSE - Status (Header) = "_$P($G(^ABSPR(RESPIEN,500)),U)
  1.  N POSITION S POSITION=$P(^ABSPT(ABSBRXI,0),U,9)
  1.  I REVERSAL S POSITION=1 ; but reversals have only 1 transaction
  1.  D LOG^ABSPOSL("RESPONSE - #"_RESPIEN_", POSITION="_POSITION)
  1.  ;IHS/OIT/SCR 2/13/09 patch 29 modify next line to avoid undefined error is no such node exists
  1.  ;I '$D(^ABSPR(RESPIEN,1000,POSITION,500)) S ERROR=1 G RESPBAD
  1.  ;IHS/OIT/SCR 05/12/09 start changes to avoid continued undefined problems patch 31
  1.  I $G(POSITION)="" D
  1.   .S ERROR=1
  1.   .D RESPBAD
  1.   .Q
  1.  Q:ERROR
  1.  I $G(^ABSPR(RESPIEN,1000,POSITION,500))="" D
  1.  .S ERROR=1
  1.  .D RESPBAD
  1.  .Q
  1.  Q:ERROR
  1.  ;IHS/OIT/SCR 05/12/09 end changes to avoid continued undefined problems patch 31
  1.  N RESP S RESP=$P(^ABSPR(RESPIEN,1000,POSITION,500),U)
  1.  D INCSTAT^ABSPOSUD("R",$S(RESP="R":2,RESP="P":3,RESP="D":4,RESP="C":5,1:19))
  1.  D
  1.  . N X S X="RESPONSE - Position "_POSITION_" = "_RESP
  1.  . I RESP="P" S X=X_" $"_$$INSPAID1^ABSPOS03(RESPIEN,POSITION)
  1.  . D LOG^ABSPOSL(X)
  1.  ;
  1.  ;IHS/SD/lwj 10/07/02  NCPDP 5.1 changes - look at field 526 
  1.  ; (additional message) if nothing found in 504
  1.  N X S X=$G(^ABSPR(RESPIEN,1000,POSITION,504))
  1.  I X="" S X=$G(^ABSPR(RESPIEN,1000,POSITION,526))  ;IHS/SD/lwj 10/07/02
  1.  I X]"" D LOG^ABSPOSL("RESPONSE - MESSAGE - "_X)
  1.  ;
  1.  I RESP="R" D  ; rejected, give rejection reasons
  1.  .N J S J=0 F  S J=$O(^ABSPR(RESPIEN,1000,POSITION,511,J)) Q:'J  D
  1.  ..N R S R=$P($G(^ABSPR(RESPIEN,1000,POSITION,511,J,0)),U)
  1.  ..N X I R]"" D
  1.  ...S X=$O(^ABSPF(9002313.93,"B",R,0))
  1.  ...I X]"" S X=$P($G(^ABSPF(9002313.93,X,0)),U,2)
  1.  ..E  S X=""
  1.  ..D LOG^ABSPOSL("REJECT - "_R_" - "_X)
  1.  ;
  1.  N INSURER S INSURER=$P(^ABSPT(ABSBRXI,1),U,6)
  1.  I $G(INSURER)="" D RESPBAD Q  ;IHS/OIT/SCR 061809 patch 32 - if no insurer,process as corrupted response
  1.  I $$REJSLEEP^ABSPOSQ4(RESPIEN,POSITION) D  ; ins. asleep: want to retry
  1.  . D SETSTAT^ABSPOSU(31)
  1.  . N X S X=$$INCSLEEP^ABSPOSQ4(INSURER)
  1.  . S $P(^ABSPT(IEN59,8),U)=X_U_U_INSURER
  1.  . D LOG^ABSPOSL($T(+0)_" - Insurer asleep; retry scheduled for "_X)
  1.  E  D  ; else: a normal kind of response, so we are done
  1.  . D CLRSLEEP^ABSPOSQ4(INSURER,1)
  1.  . D SETSTAT^ABSPOSU(99) ; "Done"
  1.  . I $G(^ABSPT(ABSBRXI,3)) D
  1.  . . D SETRESU^ABSPOSU(0,"Cancellation tried too late; claim sent.")
  1.  . E  D
  1.  . . D SETRESU^ABSPOSU(0) ; indicates a complete response was received
  1.  ;  status reports should refer to the ^ABSPR entry
  1.  D RELSLOT^ABSPOSL
  1.  Q
  1. RESPBAD ; corrupted response escape from RESP1 ; reached by a GOTO
  1.  N MSG S MSG="Corrupted response `"_RESPIEN
  1.  D SETSTAT^ABSPOSU(99) ; "Done"
  1.  D SETRESU^ABSPOSU(6500+$G(ERROR),MSG)
  1.  D LOG^ABSPOSL(MSG)
  1.  D DONE^ABSPOSL ; close up the logging slot
  1.  Q