ABSPOSQB ; IHS/FCS/DRS - POS background, Part 1 ; [ 08/20/2002 9:01 AM ]
;;1.0;PHARMACY POINT OF SALE;**1,3,23,46,48**;JUN 21, 2001;Build 38
;
;IHS/DSD/lwj 10/09/01 on behalf of David Slauenwhite - change
; consist of one line be altered in the "C" subroutine.
; David reported:
; I think that what happens is that CLEAR59^ABSPOSIZ always
; cleans out the 9002313.59 transaction-in-progress entry so
; that C+3 always gets null for both these fields. The
; GETDIV^ABSPOSQC computes them anew, and then C+7:C+8
; stores the computed values in the correct locations so that in
; D+3, GETPHARM^ABSPOSQC will find the correct pharmacy.
;
;IHS/SD/lwj 08/20/01 NCPDP 5.1 changes
; New field added to point to the new DUR/PPS values file. The
; pointer will reside in the Outpatient Pharmacy V6.0 file following
; the release of Patch 4. For now, we are just setting up the code
; in anticipation of the field. (PCS will require the DUR/PPS
; claim segment as part of their format.)
; Since the logic is similar to the Override field -I will add this
; new field retrieval to the same place in the code.
;
;IHS/SD/RLT - 06/21/07 - 10/18/07 - Patch 23
; Get DIAGNOSIS CODE POINTER from prescription file
;
;IHS/OIT/CAS/RCS - 08/12/13 - Patch 46
; Create error message on Claim when there is no Division
Q
CLAIMINF() ;EP - from ABSPOSQA
; Send in ABSBRXI, ABSBRXR, ABSBNDC, IEN59
; Fill in as much other information as possible,
; Every 9002313.59 field must be accounted for in here!
; Even if only to say "not filled in", or to explicitly delete field.
;
N FN S FN=9002313.59
N FDA,IEN,MSG
N IEN59COM S IEN59COM=IEN59_","
;
; Now fill in missing information.
; Set up FDA(FN,IEN59_",",FIELD)=internal value
;
; ***
; *** Fields in the ^(0) node
; ***
; .01 ENTRY# already done
; .13 TYPE already done ; use $$TYPE^ABSPOSQ to infer it from IEN59 in here
; 1 STATUS already done
; 2 PCN not yet
; 3 CLAIM not yet
; 4 RESPONSE not yet
;
; 12 VISIT - set up ABSBVISI
;
A S ABSBVISI=$P(^ABSPT(IEN59,0),U,7)
I 'ABSBVISI D ; need to lookup visit
. I $$TYPE^ABSPOSQ=3 D ; if supply item, we found visit from ^PSRX
. . D IMPOSS^ABSPOSUE("DB,P","TI","Supply item must have visit by now.",IEN59,"A",$T(+0))
. D VISIT^ABSPOSQC
. S FDA(FN,IEN59COM,12)=ABSBVISI
I 'ABSBVISI Q 12 ; result code 12 - visit lookup failed
;
; Make sure there's a VCN number assigned to this visit
;
A1 I $$MAKEVCN^ABSPOSQ D SETVCN^ABSPOSQD
;
; 5 PATIENT - set up ABSBPATI
;
B S ABSBPATI=$P(^ABSPT(IEN59,0),U,6)
I 'ABSBPATI D
. S ABSBPATI=$P(^AUPNVSIT(ABSBVISI,0),U,5)
. S FDA(FN,IEN59COM,5)=ABSBPATI
;
; 7 LAST UPDATE not here
; 14 POSITION IN CLAIM not here
; 13 USER already done
; 15 START TIME already done
; 16 COMMS LOG not yet
;
; ***
; *** Fields in the ^(1) node
; ***
; 9 ABSBRXR already done
; 10 ABSBNDC
S FDA(FN,IEN59COM,10)=ABSBNDC ; usually already there
;
; 8 VCPT - at the very end, in a separate billing job,
; in the billing programs, ABSPOSB*
;
; 11 ABSBDIV - ABSBPDIV, pointer to ^PS(59,ABSBPDIV,*)
; 1.05 ABSBDIV SOURCE - ABSBSDIV, source = 1
;
C S ABSBPDIV=$P(^ABSPT(IEN59,1),U,4)
I ABSBPDIV D
. N X S X=^ABSPT(IEN59,1)
. ;IHS/DSD/lwj 10/09/01 nxt line changed to line below
. ;S ABSBSDIV=$P(X,U,4),ABSBPDIV=$P(X,U,5) ;IHS/DSD/lwj 10/09/01
. S ABSBPDIV=$P(X,U,4),ABSBSDIV=$P(X,U,5) ;IHS/DSD/lwj 10/09/01
; end of 10/09/01 changes
I 'ABSBPDIV D
. D GETDIV^ABSPOSQC ; needs ABSBRXI,ABSBRXR
. I $$TYPE^ABSPOSQ=1!($$TYPE^ABSPOSQ=2) D ; prescription or postage
. . S FDA(FN,IEN59COM,11)=ABSBPDIV
. . S FDA(FN,IEN59COM,1.05)=ABSBSDIV
;
; 1.07 PHARMACY (depends on ABSBSDIV,ABSBPDIV)
;
D S ABSPHARM=$P(^ABSPT(IEN59,1),U,7)
I 'ABSPHARM D
. D GETPHARM^ABSPOSQC
. S FDA(FN,IEN59COM,1.07)=ABSPHARM
I 'ABSPHARM Q 105 ; OIT/CAS/RCS 081313 Patch 46, result code 105 - pharmacy lookup failed
;
; 1.06 INSURER - see ^(6) and ^(7), below
; 1.08 PINS PIECE - see ^(6) and ^(7), below
;
; 1.09 PREAUTHORIZATION NUMBER
; May someday need to do an extra lookup here.
; Thinking of Puyallup, where an extensive preauthorization number
; database scheme has been set up in the past.
; (And more typically, may be handled by the NCPDP OVERRIDE
;
; 1.11 ABSBRXI already done
;
; 1.12 RESUBMIT AFTER REVERSAL
; How's that work again? It was set by the caller, right?
;
; 1.13 NCPDP OVERRIDES
I $$TYPE^ABSPOSQ=1!($$TYPE^ABSPOSQ=2) D
. N ABSPRXI,ABSPRXR
. S ABSPRXI=$$RXI^ABSPOSQ
. S ABSPRXR=$$RXR^ABSPOSQ
. ;N X S X=$$GETIEN^ABSPOSO($$RXI^ABSPOSQ,$$RXR^ABSPOSQ)
. N X S X=$$GETIEN^ABSPOSO(ABSPRXI,ABSPRXR)
. I X S FDA(FN,IEN59COM,1.13)=X
. ;
. ;IHS/SD/lwj 8/20/02 NCPDP 5.1 changes - add the retrieval of the
. ; DUR/PPS pointer from the prescription file
. ;N DUR S DUR=$$GETDUR^ABSPOSO($$RXI^ABSPOSQ,$$RXR^ABSPOSQ)
. N DUR S DUR=$$GETDUR^ABSPOSO(ABSPRXI,ABSPRXR)
. I DUR S FDA(FN,IEN59COM,1.14)=DUR
. ;
. ;IHS/SD/RLT - 06/21/07 - 10/18/07 - Patch 23
. ; Get DIAGNOSIS CODE POINTER
. ;N DIAG S DIAG=$$GETDIAG^ABSPOSO($$RXI^ABSPOSQ,$$RXR^ABSPOSQ)
. N DIAG S DIAG=$$GETDIAG^ABSPOSO(ABSPRXI,ABSPRXR)
. I DIAG S FDA(FN,IEN59COM,1.17)=DIAG
;
; ***
; *** Fields in the ^(2) node - RESULT CODE, RESULT TEXT - not here
; *** In the ^(3) node - CANCELLATION REQUESTED - not here
; *** In the ^(4) node - REVERSAL CLAIM, REVERSAL RESPONSE - not here
; ***
;
; ***
; *** INSURANCE data
; *** Fields 1.06 INSURER and 1.08 PINS PIECE
; *** And the ^(6) and ^(7) nodes
; ***
S INSURER=$P(^ABSPT(IEN59,1),U,6)
I I INSURER D ; whoever set up this entry included insurance data
. ; nothing more to do right now
E D ; insurance data not set up; establish defaults here and now
. N INSARRAY
. I $$TYPE^ABSPOSQ=2 D ; postage: try to take same insur. as prescrip
. . N N57 S N57=$$N57LAST^ABSPOSQ() Q:'N57 ; last transaction
. . N TMP M TMP=^ABSPTL(N57) Q:'$D(TMP(6))
. . S INSARRAY(0)=$L(TMP(6),U)
. . N I F I=1:1:$L(TMP(6),U) D
. . . S INSARRAY(I)=$P(TMP(7),U,I)_U_$P(TMP(6),U,I)
. I '$D(INSARRAY) D INSURER^ABSPOS25(.INSARRAY)
. ; INSARRAY(0)=count^other junk...
. ; INSARRAY(n)=insurer^pins
. N I F I=1:1:$P(INSARRAY(0),U) D
. . I I>3 Q
. . S FDA(FN,IEN59COM,I+700)=$P(INSARRAY(I),U)
. . S FDA(FN,IEN59COM,I+600)=$P(INSARRAY(I),U,2)
. . I I=1 D
. . . S (INSURER,FDA(FN,IEN59COM,1.06))=$P(INSARRAY(I),U)
. . . S FDA(FN,IEN59COM,1.08)=1
;
; *** Check to make sure Prescriber NPI is defined - it is now required
;
N N NPI D I 'NPI Q 106 ; OIT/CAS/RCS 081913 Patch 46, result code 106 - prescriber NPI lookup failed
.N PROVIEN,ABSPRXI,XUSDATE
.S ABSPRXI=$$RXI^ABSPOSQ,PROVIEN=$P($G(^PSRX(ABSPRXI,0)),U,4),NPI=$P($$NPI^XUSNPI("Individual_ID",+PROVIEN),U)
;
; ***
; *** PRICING data - in the ^(5) node
; ***
;
P N PRICING S PRICING=$G(^ABSPT(IEN59,5))
I $P(PRICING,U,5)]"" D
. ; do nothing; pricing is already determined
E D ; need to figure out pricing
. I $$TYPE^ABSPOSQ=2 D
. . D IMPOSS^ABSPOSUE("DB,P","TI","Pricing of postage must already be in place by now.",IEN59,"P:2",$T(+0))
. E I $$TYPE^ABSPOSQ=3 D
. . D IMPOSS^ABSPOSUE("DB,P","TI","Pricing of supplies must already be in place by now.",IEN59,"P:3",$T(+0))
. E I $$TYPE^ABSPOSQ=1 D ; Drug pricing:
. . N DRGDFN,DRGNAME,PROVDFN,PROV,PRICALC
. . N ABSBRXI,ABSBRXR,ABSBNDC,ABSBDRGI
. . S ABSBRXI=$$RXI^ABSPOSQ,ABSBRXR=$$RXR^ABSPOSQ,ABSBNDC=$$NDC^ABSPOSQ
. . S ABSBDRGI=$$DRGDFN^ABSPOSQ ; INSURER was set above
. . D EN^ABSPOSQP ; and PRICING is set for you
. N I F I=1:1:5 S FDA(FN,IEN59COM,I+500)=$P(PRICING,U,I)
;
; The 9002313.59 entry has all the data it should have at this point.
; Store whatever data were just determined in this routine.
;
FILE1 I $D(FDA) D FILE^DIE("","FDA","MSG") ; /IHS/OIT/RAM ; 12 JUN 17 ; REMOVED A CONFUSING "DOUBLE-DO" HERE.
I $D(MSG) D LOG^ABSPOSL2("F^ABSPOSBX",.MSG) ; /IHS/OIT/RAM ; 12 JUN 17 ; AND LOG IT IF AN ERROR OCCURS.
I $D(MSG) D G FILE99
. D LOG^ABSPOSL("Error in D FILE^DIE at tag FILE1^"_$T(+0))
. D LOGMSG ; failure - log returned diagnostics
;
FILE99 D LOG59 ; log a copy of what's in the IEN59 now
Q $S($D(MSG):1000,1:0) ; >0 if error, =0 if no error
;
LOGMSG D LOG^ABSPOSL("Error returned by FILE^DIE")
D LOGARRAY("MSG") Q ; log the MSG array
LOGARRAY(Q) ;EP - ABSPOSQD
I $D(@Q)#10 D LOG^ABSPOSL(Q_"="_@Q)
F S Q=$Q(@Q) Q:Q="" D LOG^ABSPOSL(Q_"="_@Q)
Q
LOG59 ; log the IEN59 entry
N A M A=^ABSPT(IEN59)
D LOG^ABSPOSL("Contents of ^ABSPT("_IEN59_") :")
D LOGARRAY("A")
Q
LOG59A ;EP - from REVERS59^ABSPOS6D
N SAVESLOT S SAVESLOT=$$GETSLOT^ABSPOSL
D SETSLOT^ABSPOSL(IEN59)
D LOG59
D RELSLOT^ABSPOSL
D SETSLOT^ABSPOSL(SAVESLOT)
Q
ABSPOSQB ; IHS/FCS/DRS - POS background, Part 1 ; [ 08/20/2002 9:01 AM ]
+1 ;;1.0;PHARMACY POINT OF SALE;**1,3,23,46,48**;JUN 21, 2001;Build 38
+2 ;
+3 ;IHS/DSD/lwj 10/09/01 on behalf of David Slauenwhite - change
+4 ; consist of one line be altered in the "C" subroutine.
+5 ; David reported:
+6 ; I think that what happens is that CLEAR59^ABSPOSIZ always
+7 ; cleans out the 9002313.59 transaction-in-progress entry so
+8 ; that C+3 always gets null for both these fields. The
+9 ; GETDIV^ABSPOSQC computes them anew, and then C+7:C+8
+10 ; stores the computed values in the correct locations so that in
+11 ; D+3, GETPHARM^ABSPOSQC will find the correct pharmacy.
+12 ;
+13 ;IHS/SD/lwj 08/20/01 NCPDP 5.1 changes
+14 ; New field added to point to the new DUR/PPS values file. The
+15 ; pointer will reside in the Outpatient Pharmacy V6.0 file following
+16 ; the release of Patch 4. For now, we are just setting up the code
+17 ; in anticipation of the field. (PCS will require the DUR/PPS
+18 ; claim segment as part of their format.)
+19 ; Since the logic is similar to the Override field -I will add this
+20 ; new field retrieval to the same place in the code.
+21 ;
+22 ;IHS/SD/RLT - 06/21/07 - 10/18/07 - Patch 23
+23 ; Get DIAGNOSIS CODE POINTER from prescription file
+24 ;
+25 ;IHS/OIT/CAS/RCS - 08/12/13 - Patch 46
+26 ; Create error message on Claim when there is no Division
+27 QUIT
CLAIMINF() ;EP - from ABSPOSQA
+1 ; Send in ABSBRXI, ABSBRXR, ABSBNDC, IEN59
+2 ; Fill in as much other information as possible,
+3 ; Every 9002313.59 field must be accounted for in here!
+4 ; Even if only to say "not filled in", or to explicitly delete field.
+5 ;
+6 NEW FN
SET FN=9002313.59
+7 NEW FDA,IEN,MSG
+8 NEW IEN59COM
SET IEN59COM=IEN59_","
+9 ;
+10 ; Now fill in missing information.
+11 ; Set up FDA(FN,IEN59_",",FIELD)=internal value
+12 ;
+13 ; ***
+14 ; *** Fields in the ^(0) node
+15 ; ***
+16 ; .01 ENTRY# already done
+17 ; .13 TYPE already done ; use $$TYPE^ABSPOSQ to infer it from IEN59 in here
+18 ; 1 STATUS already done
+19 ; 2 PCN not yet
+20 ; 3 CLAIM not yet
+21 ; 4 RESPONSE not yet
+22 ;
+23 ; 12 VISIT - set up ABSBVISI
+24 ;
A SET ABSBVISI=$PIECE(^ABSPT(IEN59,0),U,7)
+1 ; need to lookup visit
IF 'ABSBVISI
Begin DoDot:1
+2 ; if supply item, we found visit from ^PSRX
IF $$TYPE^ABSPOSQ=3
Begin DoDot:2
+3 DO IMPOSS^ABSPOSUE("DB,P","TI","Supply item must have visit by now.",IEN59,"A",$TEXT(+0))
End DoDot:2
+4 DO VISIT^ABSPOSQC
+5 SET FDA(FN,IEN59COM,12)=ABSBVISI
End DoDot:1
+6 ; result code 12 - visit lookup failed
IF 'ABSBVISI
QUIT 12
+7 ;
+8 ; Make sure there's a VCN number assigned to this visit
+9 ;
A1 IF $$MAKEVCN^ABSPOSQ
DO SETVCN^ABSPOSQD
+1 ;
+2 ; 5 PATIENT - set up ABSBPATI
+3 ;
B SET ABSBPATI=$PIECE(^ABSPT(IEN59,0),U,6)
+1 IF 'ABSBPATI
Begin DoDot:1
+2 SET ABSBPATI=$PIECE(^AUPNVSIT(ABSBVISI,0),U,5)
+3 SET FDA(FN,IEN59COM,5)=ABSBPATI
End DoDot:1
+4 ;
+5 ; 7 LAST UPDATE not here
+6 ; 14 POSITION IN CLAIM not here
+7 ; 13 USER already done
+8 ; 15 START TIME already done
+9 ; 16 COMMS LOG not yet
+10 ;
+11 ; ***
+12 ; *** Fields in the ^(1) node
+13 ; ***
+14 ; 9 ABSBRXR already done
+15 ; 10 ABSBNDC
+16 ; usually already there
SET FDA(FN,IEN59COM,10)=ABSBNDC
+17 ;
+18 ; 8 VCPT - at the very end, in a separate billing job,
+19 ; in the billing programs, ABSPOSB*
+20 ;
+21 ; 11 ABSBDIV - ABSBPDIV, pointer to ^PS(59,ABSBPDIV,*)
+22 ; 1.05 ABSBDIV SOURCE - ABSBSDIV, source = 1
+23 ;
C SET ABSBPDIV=$PIECE(^ABSPT(IEN59,1),U,4)
+1 IF ABSBPDIV
Begin DoDot:1
+2 NEW X
SET X=^ABSPT(IEN59,1)
+3 ;IHS/DSD/lwj 10/09/01 nxt line changed to line below
+4 ;S ABSBSDIV=$P(X,U,4),ABSBPDIV=$P(X,U,5) ;IHS/DSD/lwj 10/09/01
+5 ;IHS/DSD/lwj 10/09/01
SET ABSBPDIV=$PIECE(X,U,4)
SET ABSBSDIV=$PIECE(X,U,5)
End DoDot:1
+6 ; end of 10/09/01 changes
+7 IF 'ABSBPDIV
Begin DoDot:1
+8 ; needs ABSBRXI,ABSBRXR
DO GETDIV^ABSPOSQC
+9 ; prescription or postage
IF $$TYPE^ABSPOSQ=1!($$TYPE^ABSPOSQ=2)
Begin DoDot:2
+10 SET FDA(FN,IEN59COM,11)=ABSBPDIV
+11 SET FDA(FN,IEN59COM,1.05)=ABSBSDIV
End DoDot:2
End DoDot:1
+12 ;
+13 ; 1.07 PHARMACY (depends on ABSBSDIV,ABSBPDIV)
+14 ;
D SET ABSPHARM=$PIECE(^ABSPT(IEN59,1),U,7)
+1 IF 'ABSPHARM
Begin DoDot:1
+2 DO GETPHARM^ABSPOSQC
+3 SET FDA(FN,IEN59COM,1.07)=ABSPHARM
End DoDot:1
+4 ; OIT/CAS/RCS 081313 Patch 46, result code 105 - pharmacy lookup failed
IF 'ABSPHARM
QUIT 105
+5 ;
+6 ; 1.06 INSURER - see ^(6) and ^(7), below
+7 ; 1.08 PINS PIECE - see ^(6) and ^(7), below
+8 ;
+9 ; 1.09 PREAUTHORIZATION NUMBER
+10 ; May someday need to do an extra lookup here.
+11 ; Thinking of Puyallup, where an extensive preauthorization number
+12 ; database scheme has been set up in the past.
+13 ; (And more typically, may be handled by the NCPDP OVERRIDE
+14 ;
+15 ; 1.11 ABSBRXI already done
+16 ;
+17 ; 1.12 RESUBMIT AFTER REVERSAL
+18 ; How's that work again? It was set by the caller, right?
+19 ;
+20 ; 1.13 NCPDP OVERRIDES
+21 IF $$TYPE^ABSPOSQ=1!($$TYPE^ABSPOSQ=2)
Begin DoDot:1
+22 NEW ABSPRXI,ABSPRXR
+23 SET ABSPRXI=$$RXI^ABSPOSQ
+24 SET ABSPRXR=$$RXR^ABSPOSQ
+25 ;N X S X=$$GETIEN^ABSPOSO($$RXI^ABSPOSQ,$$RXR^ABSPOSQ)
+26 NEW X
SET X=$$GETIEN^ABSPOSO(ABSPRXI,ABSPRXR)
+27 IF X
SET FDA(FN,IEN59COM,1.13)=X
+28 ;
+29 ;IHS/SD/lwj 8/20/02 NCPDP 5.1 changes - add the retrieval of the
+30 ; DUR/PPS pointer from the prescription file
+31 ;N DUR S DUR=$$GETDUR^ABSPOSO($$RXI^ABSPOSQ,$$RXR^ABSPOSQ)
+32 NEW DUR
SET DUR=$$GETDUR^ABSPOSO(ABSPRXI,ABSPRXR)
+33 IF DUR
SET FDA(FN,IEN59COM,1.14)=DUR
+34 ;
+35 ;IHS/SD/RLT - 06/21/07 - 10/18/07 - Patch 23
+36 ; Get DIAGNOSIS CODE POINTER
+37 ;N DIAG S DIAG=$$GETDIAG^ABSPOSO($$RXI^ABSPOSQ,$$RXR^ABSPOSQ)
+38 NEW DIAG
SET DIAG=$$GETDIAG^ABSPOSO(ABSPRXI,ABSPRXR)
+39 IF DIAG
SET FDA(FN,IEN59COM,1.17)=DIAG
End DoDot:1
+40 ;
+41 ; ***
+42 ; *** Fields in the ^(2) node - RESULT CODE, RESULT TEXT - not here
+43 ; *** In the ^(3) node - CANCELLATION REQUESTED - not here
+44 ; *** In the ^(4) node - REVERSAL CLAIM, REVERSAL RESPONSE - not here
+45 ; ***
+46 ;
+47 ; ***
+48 ; *** INSURANCE data
+49 ; *** Fields 1.06 INSURER and 1.08 PINS PIECE
+50 ; *** And the ^(6) and ^(7) nodes
+51 ; ***
+52 SET INSURER=$PIECE(^ABSPT(IEN59,1),U,6)
I ; whoever set up this entry included insurance data
IF INSURER
Begin DoDot:1
+1 ; nothing more to do right now
End DoDot:1
+2 ; insurance data not set up; establish defaults here and now
IF '$TEST
Begin DoDot:1
+3 NEW INSARRAY
+4 ; postage: try to take same insur. as prescrip
IF $$TYPE^ABSPOSQ=2
Begin DoDot:2
+5 ; last transaction
NEW N57
SET N57=$$N57LAST^ABSPOSQ()
IF 'N57
QUIT
+6 NEW TMP
MERGE TMP=^ABSPTL(N57)
IF '$DATA(TMP(6))
QUIT
+7 SET INSARRAY(0)=$LENGTH(TMP(6),U)
+8 NEW I
FOR I=1:1:$LENGTH(TMP(6),U)
Begin DoDot:3
+9 SET INSARRAY(I)=$PIECE(TMP(7),U,I)_U_$PIECE(TMP(6),U,I)
End DoDot:3
End DoDot:2
+10 IF '$DATA(INSARRAY)
DO INSURER^ABSPOS25(.INSARRAY)
+11 ; INSARRAY(0)=count^other junk...
+12 ; INSARRAY(n)=insurer^pins
+13 NEW I
FOR I=1:1:$PIECE(INSARRAY(0),U)
Begin DoDot:2
+14 IF I>3
QUIT
+15 SET FDA(FN,IEN59COM,I+700)=$PIECE(INSARRAY(I),U)
+16 SET FDA(FN,IEN59COM,I+600)=$PIECE(INSARRAY(I),U,2)
+17 IF I=1
Begin DoDot:3
+18 SET (INSURER,FDA(FN,IEN59COM,1.06))=$PIECE(INSARRAY(I),U)
+19 SET FDA(FN,IEN59COM,1.08)=1
End DoDot:3
End DoDot:2
End DoDot:1
+20 ;
+21 ; *** Check to make sure Prescriber NPI is defined - it is now required
+22 ;
N ; OIT/CAS/RCS 081913 Patch 46, result code 106 - prescriber NPI lookup failed
NEW NPI
Begin DoDot:1
+1 NEW PROVIEN,ABSPRXI,XUSDATE
+2 SET ABSPRXI=$$RXI^ABSPOSQ
SET PROVIEN=$PIECE($GET(^PSRX(ABSPRXI,0)),U,4)
SET NPI=$PIECE($$NPI^XUSNPI("Individual_ID",+PROVIEN),U)
End DoDot:1
IF 'NPI
QUIT 106
+3 ;
+4 ; ***
+5 ; *** PRICING data - in the ^(5) node
+6 ; ***
+7 ;
P NEW PRICING
SET PRICING=$GET(^ABSPT(IEN59,5))
+1 IF $PIECE(PRICING,U,5)]""
Begin DoDot:1
+2 ; do nothing; pricing is already determined
End DoDot:1
+3 ; need to figure out pricing
IF '$TEST
Begin DoDot:1
+4 IF $$TYPE^ABSPOSQ=2
Begin DoDot:2
+5 DO IMPOSS^ABSPOSUE("DB,P","TI","Pricing of postage must already be in place by now.",IEN59,"P:2",$TEXT(+0))
End DoDot:2
+6 IF '$TEST
IF $$TYPE^ABSPOSQ=3
Begin DoDot:2
+7 DO IMPOSS^ABSPOSUE("DB,P","TI","Pricing of supplies must already be in place by now.",IEN59,"P:3",$TEXT(+0))
End DoDot:2
+8 ; Drug pricing:
IF '$TEST
IF $$TYPE^ABSPOSQ=1
Begin DoDot:2
+9 NEW DRGDFN,DRGNAME,PROVDFN,PROV,PRICALC
+10 NEW ABSBRXI,ABSBRXR,ABSBNDC,ABSBDRGI
+11 SET ABSBRXI=$$RXI^ABSPOSQ
SET ABSBRXR=$$RXR^ABSPOSQ
SET ABSBNDC=$$NDC^ABSPOSQ
+12 ; INSURER was set above
SET ABSBDRGI=$$DRGDFN^ABSPOSQ
+13 ; and PRICING is set for you
DO EN^ABSPOSQP
End DoDot:2
+14 NEW I
FOR I=1:1:5
SET FDA(FN,IEN59COM,I+500)=$PIECE(PRICING,U,I)
End DoDot:1
+15 ;
+16 ; The 9002313.59 entry has all the data it should have at this point.
+17 ; Store whatever data were just determined in this routine.
+18 ;
FILE1 ; /IHS/OIT/RAM ; 12 JUN 17 ; REMOVED A CONFUSING "DOUBLE-DO" HERE.
IF $DATA(FDA)
DO FILE^DIE("","FDA","MSG")
+1 ; /IHS/OIT/RAM ; 12 JUN 17 ; AND LOG IT IF AN ERROR OCCURS.
IF $DATA(MSG)
DO LOG^ABSPOSL2("F^ABSPOSBX",.MSG)
+2 IF $DATA(MSG)
Begin DoDot:1
+3 DO LOG^ABSPOSL("Error in D FILE^DIE at tag FILE1^"_$TEXT(+0))
+4 ; failure - log returned diagnostics
DO LOGMSG
End DoDot:1
GOTO FILE99
+5 ;
FILE99 ; log a copy of what's in the IEN59 now
DO LOG59
+1 ; >0 if error, =0 if no error
QUIT $SELECT($DATA(MSG):1000,1:0)
+2 ;
LOGMSG DO LOG^ABSPOSL("Error returned by FILE^DIE")
+1 ; log the MSG array
DO LOGARRAY("MSG")
QUIT
LOGARRAY(Q) ;EP - ABSPOSQD
+1 IF $DATA(@Q)#10
DO LOG^ABSPOSL(Q_"="_@Q)
+2 FOR
SET Q=$QUERY(@Q)
IF Q=""
QUIT
DO LOG^ABSPOSL(Q_"="_@Q)
+3 QUIT
LOG59 ; log the IEN59 entry
+1 NEW A
MERGE A=^ABSPT(IEN59)
+2 DO LOG^ABSPOSL("Contents of ^ABSPT("_IEN59_") :")
+3 DO LOGARRAY("A")
+4 QUIT
LOG59A ;EP - from REVERS59^ABSPOS6D
+1 NEW SAVESLOT
SET SAVESLOT=$$GETSLOT^ABSPOSL
+2 DO SETSLOT^ABSPOSL(IEN59)
+3 DO LOG59
+4 DO RELSLOT^ABSPOSL
+5 DO SETSLOT^ABSPOSL(SAVESLOT)
+6 QUIT
