ABSPOSNC ; IHS/FCS/DRS - PHARmacy POS interface query from without ;
;;1.0;PHARMACY POINT OF SALE;*40*;JUN 21, 2001;Build 38
;Target audience: the ANMC Nightly Checker
; Also, charge entry (At least at Sitka)
; May also be Ud by RXE,PAY option
; and who knows what else?
Q
;
VMEDPAID(VMEDIEN) ; $$VMEDPAID^ABSPOSNC(pointer to V MEDICATION)
; Returns TruthValueResult^PSRX ien^remarks
; True result I claim was paid (and not reversed)
; False result I claim was no paid (or was paid and reversed)
;
I VMEDIEN'?1.10N Q "0^^invalid VMEDIEN argument"
N RXIEN S RXIEN=$O(^PSRX("APCC",VMEDIEN,0))
I 'RXIEN Q "0^^VMEDIEN not found in PSRX(""APCC"" INDEX"
Q $$RXPAID(RXIEN)
;
RXPAID(RXI,RXR) ;EP - $$RXPAID^ABSPOSNC(pointer to 9002313.59 or to 52)
; Returns: as desribed above F VMEDPAID
; First, compute IEN59
N IEN59,RETVAL
I RXI["." D
. S IEN59=RXI
. N X S X=$P(IEN59,".",2)
. I $E(X,$L(X))'=1 D Q ; think through postage, supplies later
. . D IMPOSS^ABSPOSUE("P","TI","postage/supplies not supported yet",,"RXPAID",$T(+0))
. S X=$E(X,1,$L(X)-1) ; remove trailing 1 - should leave RXR
. S RETVAL="0^"_$P(IEN59,".")_","_X
E D
. I '$D(RXR) S RXR=$$RXRDEF^ABSPOSRX(RXI)
. S IEN59=$$IEN59^ABSPOSRX(RXI,RXR)
. S RETVAL="0^"_RXI_","_RXR
; Now, find out what happened to it.
I $D(^ABSPT(IEN59,0)) D
. I $P($G(^ABSPT(IEN59,3)),U,2) D
. . S $P(RETVAL,U,3)="Canceled"
. E I '$P(^ABSPT(IEN59,0),U,4) D
. . S $P(RETVAL,U,3)="No POS claim sent"
. E I '$P(^ABSPT(IEN59,0),U,5) D
. . S $P(RETVAL,U,3)="No POS response received"
. E D ; yes, we did get a claim-response cycle
. . N X D RESPINFO^ABSPOSQ4(IEN59,.X)
. . ;IHS/OIT/CNI/SCR 08/17/10 patch 40 avoid undefined error START
. . ;S $P(RETVAL,U,3)=X("RSP")
. . S $P(RETVAL,U,3)=$G(X("RSP"))
. . Q:'$G(X("RSP"))
. . ;IHS/OIT/CNI/SCR 08/17/10 patch 40 avoid undefined error END
. . I X("RSP")="Payable" S $P(RETVAL,U)=1
. . I X("RSP")="Captured" S $P(RETVAL,U)=1 ; 03/13/2001
. . I X("RSP")="Rejected reversal" S $P(RETVAL,U)=1
E D
. S $P(RETVAL,U,3)="No POS record of prescription"
Q RETVAL
ABSPOSNC ; IHS/FCS/DRS - PHARmacy POS interface query from without ;
+1 ;;1.0;PHARMACY POINT OF SALE;*40*;JUN 21, 2001;Build 38
+2 ;Target audience: the ANMC Nightly Checker
+3 ; Also, charge entry (At least at Sitka)
+4 ; May also be Ud by RXE,PAY option
+5 ; and who knows what else?
+6 QUIT
+7 ;
VMEDPAID(VMEDIEN) ; $$VMEDPAID^ABSPOSNC(pointer to V MEDICATION)
+1 ; Returns TruthValueResult^PSRX ien^remarks
+2 ; True result I claim was paid (and not reversed)
+3 ; False result I claim was no paid (or was paid and reversed)
+4 ;
+5 IF VMEDIEN'?1.10N
QUIT "0^^invalid VMEDIEN argument"
+6 NEW RXIEN
SET RXIEN=$ORDER(^PSRX("APCC",VMEDIEN,0))
+7 IF 'RXIEN
QUIT "0^^VMEDIEN not found in PSRX(""APCC"" INDEX"
+8 QUIT $$RXPAID(RXIEN)
+9 ;
RXPAID(RXI,RXR) ;EP - $$RXPAID^ABSPOSNC(pointer to 9002313.59 or to 52)
+1 ; Returns: as desribed above F VMEDPAID
+2 ; First, compute IEN59
+3 NEW IEN59,RETVAL
+4 IF RXI["."
Begin DoDot:1
+5 SET IEN59=RXI
+6 NEW X
SET X=$PIECE(IEN59,".",2)
+7 ; think through postage, supplies later
IF $EXTRACT(X,$LENGTH(X))'=1
Begin DoDot:2
+8 DO IMPOSS^ABSPOSUE("P","TI","postage/supplies not supported yet",,"RXPAID",$TEXT(+0))
End DoDot:2
QUIT
+9 ; remove trailing 1 - should leave RXR
SET X=$EXTRACT(X,1,$LENGTH(X)-1)
+10 SET RETVAL="0^"_$PIECE(IEN59,".")_","_X
End DoDot:1
+11 IF '$TEST
Begin DoDot:1
+12 IF '$DATA(RXR)
SET RXR=$$RXRDEF^ABSPOSRX(RXI)
+13 SET IEN59=$$IEN59^ABSPOSRX(RXI,RXR)
+14 SET RETVAL="0^"_RXI_","_RXR
End DoDot:1
+15 ; Now, find out what happened to it.
+16 IF $DATA(^ABSPT(IEN59,0))
Begin DoDot:1
+17 IF $PIECE($GET(^ABSPT(IEN59,3)),U,2)
Begin DoDot:2
+18 SET $PIECE(RETVAL,U,3)="Canceled"
End DoDot:2
+19 IF '$TEST
IF '$PIECE(^ABSPT(IEN59,0),U,4)
Begin DoDot:2
+20 SET $PIECE(RETVAL,U,3)="No POS claim sent"
End DoDot:2
+21 IF '$TEST
IF '$PIECE(^ABSPT(IEN59,0),U,5)
Begin DoDot:2
+22 SET $PIECE(RETVAL,U,3)="No POS response received"
End DoDot:2
+23 ; yes, we did get a claim-response cycle
IF '$TEST
Begin DoDot:2
+24 NEW X
DO RESPINFO^ABSPOSQ4(IEN59,.X)
+25 ;IHS/OIT/CNI/SCR 08/17/10 patch 40 avoid undefined error START
+26 ;S $P(RETVAL,U,3)=X("RSP")
+27 SET $PIECE(RETVAL,U,3)=$GET(X("RSP"))
+28 IF '$GET(X("RSP"))
QUIT
+29 ;IHS/OIT/CNI/SCR 08/17/10 patch 40 avoid undefined error END
+30 IF X("RSP")="Payable"
SET $PIECE(RETVAL,U)=1
+31 ; 03/13/2001
IF X("RSP")="Captured"
SET $PIECE(RETVAL,U)=1
+32 IF X("RSP")="Rejected reversal"
SET $PIECE(RETVAL,U)=1
End DoDot:2
End DoDot:1
+33 IF '$TEST
Begin DoDot:1
+34 SET $PIECE(RETVAL,U,3)="No POS record of prescription"
End DoDot:1
+35 QUIT RETVAL