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

ABSPOSQG.m

Go to the documentation of this file. 
  1. ABSPOSQG ; IHS/FCS/DRS - form transmission packets ; 
  1.  ;;1.0;PHARMACY POINT OF SALE;**37,42**;JUN 21, 2001;Build 38
  1.  Q
  1.  ; PACKET(), split off from ABSPOSQ2
  1.  ;
  1. PACKET() ;EP - ABSPOSQ2
  1.  ; packetize one prescription (and possibly more prescriptions
  1.  ; for the same patient, if they're ready now.)
  1.  ; Called from ABSPOSQ2,
  1.  ;  which gave us RXILIST(IEN59) array of claims to packetize.
  1.  ;
  1.  N X S X="PACKERR^"_$T(+0),@^%ZOSF("TRAP")
  1.  N CLAIMIEN,DIALOUT,ERROR
  1.  S DIALOUT=$$DIALOUT
  1.  I DIALOUT="" D RELSLOT^ABSPOSL Q 1  ;IHS/IOT/SCR 012210 pre-patch 37 for Santa Rosa
  1.  ;
  1.  ; If it's a reversal, we already have an ^ABSPC(  It was
  1.  ; created by the call to ABSPECA8, way back at the beginning.
  1.  ; So, unlike claims, we need only the NCPDP formatting for it.
  1.  N FIRST59 S FIRST59=$O(RXILIST(0))
  1.  I $G(^ABSPT(FIRST59,4)) D  G POINTM
  1.  . ; Mimic a few things that are set up in the code we're skipping
  1.  . S CLAIMIEN=$P(^ABSPT(FIRST59,4),U)
  1.  . S CLAIMIEN(CLAIMIEN)=""
  1.  ; - - - - -  But if it's not a reversal, do all this stuff:  - - - - -
  1.  I $O(RXILIST($O(RXILIST("")))) D
  1.  . D LOG2LIST^ABSPOSQ("Packetizing - we have more than one claim:")
  1.  . N I,X,Y S (X,Y)=""
  1.  . F I=1:1 S X=$O(RXILIST(X)) Q:'X  D
  1.  . . S $P(Y,", ",I-1#4+1)=X
  1.  . . I I#4=0 D LOG2LIST^ABSPOSQ(Y) S Y=""
  1.  . I Y]"" D LOG2LIST^ABSPOSQ(Y)
  1.  ; - - - - -  
  1.  ; Retrieve some important variables from the POS WORKING file
  1.  ; The ones we retrieve are the same for all prescriptions in RXILIST(*)
  1.  N PATDFN S PATDFN=$P(^ABSPT(FIRST59,0),U,6)
  1.  N ABSBVISI S ABSBVISI=$P(^ABSPT(FIRST59,0),U,7)
  1.  ;
  1.  ;  ABSPOSCA calls ABSPOSCB,ABSPOSCC,ABSPOSCD to set up ABSP(*)
  1.  ;           then  ABSPOSCE to create claims in 9002313.02
  1.  ;
  1. LOCK L +^ABSPC:300 ; may be multiple copies of this running!!!
  1.  I '$T D  G LOCK:$$IMPOSS^ABSPOSUE("L","RIT","LOCK ^ABSPC claims file",,,$T(+0))
  1.  . D LOG2LIST^ABSPOSQ($T(+0)_" - unable to lock file 9002313.02 - should never happen!")
  1.  ; input RXILIST(*)
  1.  D EN^ABSPOSCA(DIALOUT) ;
  1.  ; output ERROR, CLAIMIEN, CLAIMIEN(*)
  1.  I ERROR D LOG2LIST^ABSPOSQ($T(+0)_" - ERROR="_ERROR_" returned from ABSPOSCA")
  1.  ; ABSPOSCA set up ERROR,CLAIMIEN,CLAIMIEN(*)
  1.  L -^ABSPC
  1.  I $G(CLAIMIEN)<1 Q $S(ERROR:ERROR,1:300)
  1.  ;
  1.  ; CLAIMIEN=last claim created
  1.  ; CLAIMIEN(CLAIMIEN)=the list of all claims created
  1.  ;
  1.  ; Then, ABSPOSQH calls ABSPECA1 to build NCPDP claim format records
  1.  ;
  1. POINTM ; Reversals are joining again here
  1.  D KSCRATCH^ABSPOSQ2 ; erase ^ABSPECX($J)
  1.  D PASCII^ABSPOSQH(DIALOUT) ; gives you ^ABSPECX($J,"C",CLAIMIEN,...
  1.  ;
  1.  ;  Drop the NCPDP-formatted records into the list used by
  1.  ;  the sender-receiver.  Too coarse to lock the whole list - 
  1.  ;  you'll be blocked by a sender-receiver who has one claim locked.
  1.  ; (Even though we fixed that recently so that a sender locks the
  1.  ;  claim for only the minimal amount of time.)
  1.  ;
  1.  ;  Drop each claim in there individually.
  1.  ;  And as soon as the very first one hits, rev up a sender-receiver.
  1.  ; 
  1.  N FIRST S FIRST=1
  1.  N X S X="" F  S X=$O(^ABSPECX($J,"C",X)) Q:X=""  D
  1.  . F  L +^ABSPECX("POS",DIALOUT,"C",X):60 Q:$T  Q:'$$IMPOSS^ABSPOSUE("L","RIT","LOCK claims list for DIALOUT="_DIALOUT,,"POINTM",$T(+0))
  1.  . M ^ABSPECX("POS",DIALOUT,"C",X)=^ABSPECX($J,"C",X)
  1.  . L -^ABSPECX("POS",DIALOUT,"C",X)
  1.  . N MSG S MSG="Claim ID "_$P(^ABSPC(X,0),U)
  1.  . S MSG=MSG_" queued for "_$P(^ABSP(9002313.55,DIALOUT,0),U)
  1.  . D LOG2CLM^ABSPOSQ(MSG,X)
  1.  . I FIRST D TASK^ABSPOSQ2 S FIRST=0
  1.  D RELSLOT^ABSPOSL
  1.  Q 0
  1. DIALOUT()          ; RXILIST(*) should be sent to NDC? or what other processor?
  1.  ; Return a pointer to File 9002313.55, the DIAL OUT file.
  1.  N IEN59 S IEN59=$O(RXILIST(0))
  1.  I IEN59="" Q ""   ;IHS/OIT/SCR 012210  patch 37 for if there is no IEN59 return an error Santa Rosa
  1.  N X S X=$P(^ABSPT(IEN59,1),U,6) ; INSURER
  1.  ;IHS/OIT/CASSEVER/RAN patch 42 03/31/2011 Get rid of undefined errors.
  1.  Q:'$D(^ABSPEI(X)) ""
  1.  S X=$P(^ABSPEI(X,100),U,7) ; which DIAL OUT it points to
  1.  ; get the default dial-out, otherwise
  1.  I 'X S X=$P($G(^ABSP(9002313.99,1,"DIAL-OUT DEFAULT")),U)
  1.  I 'X S X=$O(^ABSP(9002313.55,"B","DEFAULT",0))
  1.  I 'X S X=$O(^ABSP(9002313.55,0)) ; they deleted the DEFAULT one??
  1.  Q X
  1. PACKERR ; error trap comes here
  1.  D @^%ZOSF("ERRTN") ; make error log entry, too
  1.  Q "8899^INTERNAL ERROR: "_$$ZE^ABSPOS ; this will go in transaction and eventually on display screen for user