- 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
