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