- ABSPDB1D ; IHS/OIT/CASSevern/Pieran ran 1/19/2011 - Handling of outgoing NCPDP Billing "B1" Claims for D.0 (DURR,CLINICAL,COMPOUND, and COUPON segments)
- ;;1.0;PHARMACY POINT OF SALE;**42,49**;JUN 21, 2001;Build 38
- DURRPPS ;EP CALLED FROM ABSPDB1 to set up DURR/PPS SEGMENT
- Q:$D(SUPRESSG("DURR/PPS"))
- N RECCNT,DUR
- I ACTION["CLAIM" D
- . Q:'$D(ABSP("RX",MEDN,"DUR"))
- . S (RECCNT,DUR)=0
- . F S DUR=$O(ABSP("RX",MEDN,"DUR",DUR)) Q:DUR="" D
- . . S RECCNT=RECCNT+1
- . . N FIELD
- . . S RECORD=$G(RECORD)
- . . F FIELD="111",473,439,440,441,474,475,476 D
- . . . Q:$D(SUPRESF(FIELD))
- . . . I (ACTION["CLAIM"),(FIELD'=111) D
- . . . . D @(FIELD_"GET")
- . . . . D @(FIELD_"FMT")
- . . . . D @(FIELD_"SET")
- . . . ELSE D APPEND(FIELD)
- . S ^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),473.01,0)="^9002313.1001A^"_RECCNT_"^"_RECCNT
- ELSE D
- . D DURVALUE^ABSPECA1
- . Q:'$D(ABSP(9002313.1001))
- . D APPEND(111) ;Only field on segment that is not repeating
- . S DUR=0
- . F S DUR=$O(ABSP(9002313.1001,DUR)) Q:DUR="" D
- . . F FIELD=.01,439,440,441,474,475,476 D
- . . . Q:$D(SUPRESF(FIELD))
- . . . S ABSP("X")=$G(ABSP(9002313.1001,DUR,FIELD,"I"))
- . . . S:ABSP("X")'="" RECORD=RECORD_$C(28)_ABSP("X")
- Q
- ;Segment identifier
- 111GET S ABSP("X")="08"
- Q
- 111FMT S ABSP("X")=$$ANFF^ABSPECFM(ABSP("X"),2)
- Q
- 111SET ;This isn't used for the 111 Field
- Q
- ;DUR/PPS Code Counter
- 473GET I '$D(SPECIAL(473,DUR)) S ABSP("X")=$G(ABSP("RX",MEDN,"DUR",DUR,473))
- ELSE X SPECIAL(473,DUR)
- Q
- 473FMT S:ABSP("X")'="" ABSP("X")="7E"_$$ANFF^ABSPECFM($G(ABSP("X")),1)
- Q
- 473SET D FLD473^ABSPOSSG
- Q
- ;Reason for Service Code
- 439GET I '$D(SPECIAL(439,DUR)) S ABSP("X")=$G(ABSP("RX",MEDN,"DUR",DUR,439))
- ELSE X SPECIAL(439,DUR)
- Q
- 439FMT S:ABSP("X")'="" ABSP("X")="E4"_$$ANFF^ABSPECFM($G(ABSP("X")),2)
- Q
- 439SET D FLD439^ABSPOSSG
- Q
- ;Professional Service Code
- 440GET I '$D(SPECIAL(440,DUR)) S ABSP("X")=$G(ABSP("RX",MEDN,"DUR",DUR,440))
- ELSE X SPECIAL(440,DUR)
- Q
- 440FMT S:ABSP("X")'="" ABSP("X")="E5"_$$ANFF^ABSPECFM($G(ABSP("X")),2)
- Q
- 440SET D FLD440^ABSPOSSG
- Q
- ;Result of Service Coce
- 441GET I '$D(SPECIAL(441,DUR)) S ABSP("X")=$G(ABSP("RX",MEDN,"DUR",DUR,441))
- ELSE X SPECIAL(441,DUR)
- Q
- 441FMT S:ABSP("X")'="" ABSP("X")="E6"_$$ANFF^ABSPECFM($G(ABSP("X")),2)
- Q
- 441SET D FLD441^ABSPOSSG
- Q
- ;DUR/PPS Level of Effort
- 474GET I '$D(SPECIAL(474,DUR)) S ABSP("X")=$G(ABSP("RX",MEDN,"DUR",DUR,474))
- ELSE X SPECIAL(474,DUR)
- Q
- 474FMT S:ABSP("X")'="" ABSP("X")="8E"_$$ANFF^ABSPECFM($G(ABSP("X")),2)
- Q
- 474SET D FLD474^ABSPOSSG
- Q
- ;DUR Co-Agent ID Qualifier
- 475GET I '$D(SPECIAL(475,DUR)) S ABSP("X")=$G(ABSP("RX",MEDN,"DUR",DUR,475))
- ELSE X SPECIAL(475,DUR)
- Q
- 475FMT S:ABSP("X")'="" ABSP("X")="J9"_$$ANFF^ABSPECFM($G(ABSP("X")),2)
- Q
- 475SET D FLD475^ABSPOSSG
- Q
- ;DUR CO-Agent ID
- 476GET I '$D(SPECIAL(476,DUR)) S ABSP("X")=$G(ABSP("RX",MEDN,"DUR",DUR,476))
- ELSE X SPECIAL(476,DUR)
- Q
- 476FMT S:ABSP("X")'="" ABSP("X")="H6"_$$ANFF^ABSPECFM($G(ABSP("X")),19)
- Q
- 476SET D FLD476^ABSPOSSG
- Q
- COUPON ;EP CALLED FROM ABSPDB1 to set up COUPON SEGMENT
- Q:$D(SUPRESSG("Coupon"))
- N FIELD
- S RECORD=$G(RECORD)
- F FIELD="111A",485,486,487 D
- . Q:$D(SUPRESF(FIELD))
- . I (ACTION["CLAIM"),(FIELD'=111) D
- . . D @(FIELD_"GET")
- . . D @(FIELD_"FMT")
- . . D @(FIELD_"SET")
- . ELSE D APPEND(FIELD)
- Q
- ;Segment identifier
- 111AGET S ABSP("X")="09"
- Q
- 111AFMT S ABSP("X")=$$ANFF^ABSPECFM(ABSP("X"),2)
- Q
- 111ASET ;This isn't used for the 111 Field
- Q
- ;Coupon Type
- 485GET I '$D(SPECIAL(485)) S ABSP("X")=""
- ELSE X SPECIAL(485)
- Q
- 485FMT S:ABSP("X")'="" ABSP("X")="KE"_$$ANFF^ABSPECFM($G(ABSP("X")),2)
- Q
- 485SET ;Not Yet Implemented
- Q
- ;Coupon Number
- 486GET I '$D(SPECIAL(486)) S ABSP("X")=""
- ELSE X SPECIAL(486)
- Q
- 486FMT S:ABSP("X")'="" ABSP("X")="ME"_$$ANFF^ABSPECFM($G(ABSP("X")),15)
- Q
- 486SET ;Not Yet Implemented
- Q
- ;Coupon Value Amount
- 487GET I '$D(SPECIAL(487)) S ABSP("X")=""
- ELSE X SPECIAL(487)
- Q
- 487FMT S:ABSP("X")'="" ABSP("X")="NE"_$$ANFF^ABSPECFM($G(ABSP("X")),6)
- Q
- 487SET ;Not Yet Implemented
- Q
- COMPOUND ;EP CALLED FROM ABSPDB1 to set up COMPOUND SEGMENT
- Q:$D(SUPRESSG("Compound"))
- N FIELD
- S RECORD=$G(RECORD)
- F FIELD="111B",450,451,447,488,489,448,449,490,362,363 D
- . Q:$D(SUPRESF(FIELD))
- . I (ACTION["CLAIM"),(FIELD'=111) D
- . . D @(FIELD_"GET")
- . . D @(FIELD_"FMT")
- . . D @(FIELD_"SET")
- . ELSE D APPEND(FIELD)
- Q
- ;Segment identifier
- 111BGET S ABSP("X")=10
- Q
- 111BFMT S ABSP("X")=$$ANFF^ABSPECFM(ABSP("X"),2)
- Q
- 111BSET ;This isn't used for the 111 Field
- Q
- ;Compound Dosage Form Description Code
- 450GET I '$D(SPECIAL(450)) S ABSP("X")=$G(ABSP("Compound",ABSP(9002313.0201),"Dosage Form Desc"))
- ELSE X SPECIAL(450)
- Q
- 450FMT S:ABSP("X")'="" ABSP("X")="EF"_$$ANFF^ABSPECFM(ABSP("X"),2)
- Q
- 450SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),440),U,10)=ABSP("X")
- Q
- ;Compound Dispensing Unit Form Indicator
- 451GET I '$D(SPECIAL(451)) S ABSP("X")=$G(ABSP("Compound",ABSP(9002313.0201),"Disp Unit Form"))
- ELSE X SPECIAL(451)
- Q
- 451FMT S:ABSP("X")'="" ABSP("X")="EG"_$$NFF^ABSPECFM(ABSP("X"),1)
- Q
- 451SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),450),U,1)=ABSP("X")
- Q
- ;Compound Ingredient Compound Count
- 447GET I '$D(SPECIAL(447)) S ABSP("X")=$G(ABSP("Compound",ABSP(9002313.0201),"Ingred Component Cnt"))
- ELSE X SPECIAL(447)
- Q
- 447FMT S:ABSP("X")'="" ABSP("X")="EC"_$$NFF^ABSPECFM(ABSP("X"),2)
- Q
- 447SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),440),U,7)=ABSP("X")
- Q
- ;Compound Product ID Qualifier
- 488GET I '$D(SPECIAL(488)) S ABSP("X")=$G(ABSP("Compound","Product ID Qualifier"))
- ELSE X SPECIAL(488)
- Q
- 488FMT S:ABSP("X")'="" ABSP("X")="RE"_$$ANFF^ABSPECFM(ABSP("X"),2)
- Q
- 488SET ;Not Yet Implemented
- Q
- ;Compound Product ID
- 489GET I '$D(SPECIAL(489)) S ABSP("X")=$G(ABSP("Compound","Product ID"))
- ELSE X SPECIAL(489)
- Q
- 489FMT S:ABSP("X")'="" ABSP("X")="TE"_$$ANFF^ABSPECFM(ABSP("X"),19)
- Q
- 489SET ;Not Yet Implemented
- Q
- ;Compound Ingredient Quantity
- 448GET I '$D(SPECIAL(448)) S ABSP("X")=$G(ABSP("Coupound","Ingredient Quantity"))
- ELSE X SPECIAL(448)
- Q
- 448FMT S:ABSP("X")'="" ABSP("X")="ED"_$$DFF^ABSPECFM(ABSP("X"),10) ;Spec Says Length is 7?
- Q
- 448SET ;Not Yet Implemented
- Q
- ;Compound Ingredient Drug Cost
- 449GET I '$D(SPECIAL(449)) S ABSP("X")=$G(ABSP("Compound","Ingredient Drug Cost"))
- ELSE X SPECIAL(449)
- Q
- 449FMT S:ABSP("X")'="" ABSP("X")="EE"_$$DFF^ABSPEFCM(ABSP("X"),8) ;Spec says length is 6?
- Q
- 449SET ;Not Yet Implemented
- Q
- ;Compound Ingredient Basis of Cost Determination
- 490GET I '$D(SPECIAL(490)) S ABSP("X")=$G(ABSP("Compound","Ingred Basis of Cost"))
- ELSE X SPECIAL(490)
- Q
- 490FMT S:ABSP("X")'="" ABSP("X")="UE"_$$ANFF^ABSPECFM(ABSP("X"),2)
- Q
- 490SET ;Not Yet Implemented
- Q
- ;Compound Ingredient Modifier Code Count
- 362GET I '$D(SPECIAL(362)) S ABSP("X")=""
- ELSE X SPECIAL(362)
- Q
- 362FMT S:ABSP("X")'="" ABSP("X")="2G"_$$ANFF^ABSPECFM($G(ABSP("X")),2)
- Q
- 362SET ;Not Yet Implemented
- Q
- ;Compound Ingredient Modifier Code
- 363GET I '$D(SPECIAL(363)) S ABSP("X")=""
- ELSE X SPECIAL(363)
- Q
- 363FMT S:ABSP("X")'="" ABSP("X")="2H"_$$ANFF^ABSPECFM($G(ABSP("X")),2)
- Q
- 363SET ;Not Yet Implemented
- Q
- CLINICAL ;EP CALLED FROM ABSPDB1 to set up CLINICAL SEGMENT
- Q:$D(SUPRESSG("Clinical"))
- N RECCNT,DIAG
- I ACTION["CLAIM" D
- . Q:'$D(ABSP("RX",MEDN,"DIAG"))
- . ;Field 491 is only field on this segment that is not repeating do it first
- . D 491GET
- . D 491FMT
- . D 491SET
- . S (RECCNT,DIAG)=0
- . F S DIAG=$O(ABSP("RX",MEDN,"DIAG",DIAG)) Q:'+DIAG D
- . . S RECCNT=RECCNT+1
- . . N FIELD
- . . F FIELD="111C",492,424,493,494,495,496,497,499 D
- . . . Q:$D(SUPRESF(FIELD))
- . . . I (ACTION["CLAIM"),(FIELD'=111) D
- . . . . D @(FIELD_"GET")
- . . . . D @(FIELD_"FMT")
- . . . . D @(FIELD_"SET")
- . S ^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),491.01,0)="^9002313.0701A^"_RECCNT_"^"_RECCNT
- ELSE D
- . D DIAGVAL^ABSPECA1
- . Q:'$D(ABSP(9002313.0701))
- . D APPEND("111C") ;Only two non repeating fields (111, 491)
- . S ABSP("X")=$G(ABSP(9002313.0701,0,491,"I"))
- . S RECCNT=+$E(ABSP("X"),3,4)
- . S RECORD=RECORD_$C(28)_ABSP("X")
- . F DIAG=1:1:RECCNT D
- . . F FIELD=492,424,493,494,495,496,497,499 D
- . . . Q:$D(SUPRESF(FIELD))
- . . . S ABSP("X")=$G(ABSP(9002313.0701,DIAG,FIELD,"I"))
- . . . S:ABSP("X")'="" RECORD=RECORD_$C(28)_ABSP("X")
- Q
- ;Segment identifier
- 111CGET S ABSP("X")=13
- Q
- 111CFMT S ABSP("X")=$$ANFF^ABSPECFM(ABSP("X"),2)
- Q
- 111CSET ;This isn't used for the 111 Field
- Q
- ;Diagnosis Code Count
- 491GET I '$D(SPECIAL(491)) S ABSP("X")=$G(ABSP("RX",MEDN,"DIAG",0,491))
- ELSE X SPECIAL(491)
- Q
- 491FMT S:ABSP("X")'="" ABSP("X")="VE"_$$NFF^ABSPECFM(ABSP("X"),1)
- Q
- 491SET D FLD491^ABSPOSSH
- Q
- ;Diagnosis Code Qualifer
- 492GET I '$D(SPECIAL(492,DIAG)) S ABSP("X")=$G(ABSP("RX",MEDN,"DIAG",DIAG,492))
- ELSE X SPECIAL(492,DIAG)
- Q
- 492FMT S:ABSP("X")'="" ABSP("X")="WE"_$$ANFF^ABSPECFM(ABSP("X"),2)
- Q
- 492SET D FLD492^ABSPOSSH
- Q
- ;Diagnosis Code
- 424GET I '$D(SPECIAL(424,DIAG)) S ABSP("X")=$G(ABSP("RX",MEDN,"DIAG",DIAG,424))
- ELSE X SPECIAL(424,DIAG)
- Q
- 424FMT N INSIEN,REMOVE
- I ABSP("X")'="",$E(ABSP("X"),$L(ABSP("X")))="." S ABSP("X")=$E(ABSP("X"),1,$L(ABSP("X")-1))
- I ($D(SPECIAL(424))#10)=1 X SPECIAL(424) ; /IHS/OIT/RAM ; 28 SEP 17 ;P49-CR09768, ADD OVERALL FORMATTING CODE TO INSURER OVERRIDE SYSTEM.
- S INSIEN=+$G(ABSP("Insurer","IEN")),REMOVE=0
- S:INSIEN>0 REMOVE=+$P($G(^ABSPEI(INSIEN,"ICD10")),"^",2)
- S:REMOVE ABSP("X")=$TR($G(ABSP("X")),".","")
- S:ABSP("X")'="" ABSP("X")="DO"_$$ANFF^ABSPECFM($G(ABSP("X")),15)
- Q
- 424SET D FLD424^ABSPOSSH
- Q
- ;Clinical Information Counter
- 493GET I '$D(SPECIAL(493,DIAG)) S ABSP("X")=$G(ABSP("Clinical",ABSP(9002313.0201),"Information Cntr"))
- ELSE X SPECIAL(493,DIAG)
- Q
- 493FMT S:ABSP("X")'="" ABSP("X")="XE"_$$NFF^ABSPECFM(ABSP("X"),2)
- Q
- 493SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),490),U,3)=ABSP("X")
- Q
- ;Measurement Date
- 494GET I '$D(SPECIAL(494,DIAG)) D
- . S ABSP("X")=$G(ABSP("RX",MEDN,"DIAG",DIAG,494))
- . S:ABSP("X")="" ABSP("X")=$G(ABSP("Clinical","Measurement Date"))
- ELSE X SPECIAL(494,DIAG)
- Q
- 494FMT S:ABSP("X")'="" ABSP("X")="ZE"_$$NFF^ABSPECFM(ABSP("X"),8)
- Q
- 494SET ;Not Yet Implemented
- Q
- ;Measurement Time
- 495GET I '$D(SPECIAL(495,DIAG)) D
- . S ABSP("X")=$G(ABSP("RX",MEDN,"DIAG",DIAG,495))
- . S:ABSP("X")="" ABSP("X")=$G(ABSP("Clinical","Measurement Time"))
- ELSE X SPECIAL(495,DIAG)
- Q
- 495FMT S:ABSP("X")'="" ABSP("X")="H1"_$$NFF^ABSPECFM(ABSP("X"),4)
- Q
- 495SET ;Not Yet Implemented
- Q
- ;Measurement Dimension
- 496GET I '$D(SPECIAL(496,DIAG)) D
- . S ABSP("X")=$G(ABSP("RX",MEDN,"DIAG",DIAG,496))
- . S:ABSP("X")="" ABSP("X")=$G(ABSP("Clinical","Measurement Dimension"))
- ELSE X SPECIAL(496,DIAG)
- Q
- 496FMT S:ABSP("X")'="" ABSP("X")="H2"_$$ANFF^ABSPECFM(ABSP("X"),2)
- Q
- 496SET ;Not Yet Implemented
- Q
- ;Measurement Unit
- 497GET I '$D(SPECIAL(497,DIAG)) D
- . S ABSP("X")=$G(ABSP("RX",MEDN,"DIAG",DIAG,497))
- . S:ABSP("X")="" ABSP("X")=$G(ABSP("Clinical","Measurement Unit"))
- ELSE X SPECIAL(497,DIAG)
- Q
- 497FMT S:ABSP("X")'="" ABSP("X")="H3"_$$ANFF^ABSPECFM(ABSP("X"),2)
- Q
- 497SET ;Not Yet Implemented
- Q
- ;Measurement Value
- 499GET I '$D(SPECIAL(499,DIAG)) D
- . S ABSP("X")=$G(ABSP("RX",MEDN,"DIAG",DIAG,499))
- . S:ABSP("X")="" ABSP("X")=$G(ABSP("Clinical","Measurement Value"))
- ELSE X SPECIAL(499,DIAG)
- Q
- 499FMT S:ABSP("X")'="" ABSP("X")="H4"_$$ANFF^ABSPECFM(ABSP("X"),15)
- Q
- 499SET ;Not Yet Implemented
- Q
- APPEND(FIELD) ;This is where the record is built field by field
- I FIELD["111" D
- . D @(FIELD_"GET")
- . D @(FIELD_"FMT")
- . S RECORD=RECORD_$C(30,28)_"AM"_ABSP("X")
- ELSE D
- . I $G(ABSP(9002313.0201,IEN(9002313.01),FIELD,"I"))'="" S RECORD=RECORD_$C(28)_$G(ABSP(9002313.0201,IEN(9002313.01),FIELD,"I"))
- . ELSE I $D(SPECIAL(FIELD)) D
- . . X SPECIAL(FIELD)
- . . D @(FIELD_"FMT")
- . . S RECORD=RECORD_$C(28)_ABSP("X")
- Q
- ABSPDB1D ; IHS/OIT/CASSevern/Pieran ran 1/19/2011 - Handling of outgoing NCPDP Billing "B1" Claims for D.0 (DURR,CLINICAL,COMPOUND, and COUPON segments)
- +1 ;;1.0;PHARMACY POINT OF SALE;**42,49**;JUN 21, 2001;Build 38
- DURRPPS ;EP CALLED FROM ABSPDB1 to set up DURR/PPS SEGMENT
- +1 IF $DATA(SUPRESSG("DURR/PPS"))
- QUIT
- +2 NEW RECCNT,DUR
- +3 IF ACTION["CLAIM"
- Begin DoDot:1
- +4 IF '$DATA(ABSP("RX",MEDN,"DUR"))
- QUIT
- +5 SET (RECCNT,DUR)=0
- +6 FOR
- SET DUR=$ORDER(ABSP("RX",MEDN,"DUR",DUR))
- IF DUR=""
- QUIT
- Begin DoDot:2
- End DoDot:2
- End DoDot:1
- +7
- *** ERROR ***
- +8
- *** ERROR ***
- +9
- *** ERROR ***
- +10
- *** ERROR ***
- +11
- *** ERROR ***
- +12
- *** ERROR ***
- +13
- *** ERROR ***
- +14
- *** ERROR ***
- +15
- *** ERROR ***
- +16
- *** ERROR ***
- +17
- *** ERROR ***
- +18 IF '$TEST
- Begin DoDot:1
- +19 DO DURVALUE^ABSPECA1
- +20 IF '$DATA(ABSP(9002313.1001))
- QUIT
- +21 ;Only field on segment that is not repeating
- DO APPEND(111)
- +22 SET DUR=0
- +23 FOR
- SET DUR=$ORDER(ABSP(9002313.1001,DUR))
- IF DUR=""
- QUIT
- Begin DoDot:2
- +24 FOR FIELD=.01,439,440,441,474,475,476
- Begin DoDot:3
- +25 IF $DATA(SUPRESF(FIELD))
- QUIT
- +26 SET ABSP("X")=$GET(ABSP(9002313.1001,DUR,FIELD,"I"))
- +27 IF ABSP("X")'=""
- SET RECORD=RECORD_$CHAR(28)_ABSP("X")
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +28 QUIT
- +29 ;Segment identifier
- 111GET SET ABSP("X")="08"
- +1 QUIT
- 111FMT SET ABSP("X")=$$ANFF^ABSPECFM(ABSP("X"),2)
- +1 QUIT
- 111SET ;This isn't used for the 111 Field
- +1 QUIT
- +2 ;DUR/PPS Code Counter
- 473GET IF '$DATA(SPECIAL(473,DUR))
- SET ABSP("X")=$GET(ABSP("RX",MEDN,"DUR",DUR,473))
- +1 IF '$TEST
- XECUTE SPECIAL(473,DUR)
- +2 QUIT
- 473FMT IF ABSP("X")'=""
- SET ABSP("X")="7E"_$$ANFF^ABSPECFM($GET(ABSP("X")),1)
- +1 QUIT
- 473SET DO FLD473^ABSPOSSG
- +1 QUIT
- +2 ;Reason for Service Code
- 439GET IF '$DATA(SPECIAL(439,DUR))
- SET ABSP("X")=$GET(ABSP("RX",MEDN,"DUR",DUR,439))
- +1 IF '$TEST
- XECUTE SPECIAL(439,DUR)
- +2 QUIT
- 439FMT IF ABSP("X")'=""
- SET ABSP("X")="E4"_$$ANFF^ABSPECFM($GET(ABSP("X")),2)
- +1 QUIT
- 439SET DO FLD439^ABSPOSSG
- +1 QUIT
- +2 ;Professional Service Code
- 440GET IF '$DATA(SPECIAL(440,DUR))
- SET ABSP("X")=$GET(ABSP("RX",MEDN,"DUR",DUR,440))
- +1 IF '$TEST
- XECUTE SPECIAL(440,DUR)
- +2 QUIT
- 440FMT IF ABSP("X")'=""
- SET ABSP("X")="E5"_$$ANFF^ABSPECFM($GET(ABSP("X")),2)
- +1 QUIT
- 440SET DO FLD440^ABSPOSSG
- +1 QUIT
- +2 ;Result of Service Coce
- 441GET IF '$DATA(SPECIAL(441,DUR))
- SET ABSP("X")=$GET(ABSP("RX",MEDN,"DUR",DUR,441))
- +1 IF '$TEST
- XECUTE SPECIAL(441,DUR)
- +2 QUIT
- 441FMT IF ABSP("X")'=""
- SET ABSP("X")="E6"_$$ANFF^ABSPECFM($GET(ABSP("X")),2)
- +1 QUIT
- 441SET DO FLD441^ABSPOSSG
- +1 QUIT
- +2 ;DUR/PPS Level of Effort
- 474GET IF '$DATA(SPECIAL(474,DUR))
- SET ABSP("X")=$GET(ABSP("RX",MEDN,"DUR",DUR,474))
- +1 IF '$TEST
- XECUTE SPECIAL(474,DUR)
- +2 QUIT
- 474FMT IF ABSP("X")'=""
- SET ABSP("X")="8E"_$$ANFF^ABSPECFM($GET(ABSP("X")),2)
- +1 QUIT
- 474SET DO FLD474^ABSPOSSG
- +1 QUIT
- +2 ;DUR Co-Agent ID Qualifier
- 475GET IF '$DATA(SPECIAL(475,DUR))
- SET ABSP("X")=$GET(ABSP("RX",MEDN,"DUR",DUR,475))
- +1 IF '$TEST
- XECUTE SPECIAL(475,DUR)
- +2 QUIT
- 475FMT IF ABSP("X")'=""
- SET ABSP("X")="J9"_$$ANFF^ABSPECFM($GET(ABSP("X")),2)
- +1 QUIT
- 475SET DO FLD475^ABSPOSSG
- +1 QUIT
- +2 ;DUR CO-Agent ID
- 476GET IF '$DATA(SPECIAL(476,DUR))
- SET ABSP("X")=$GET(ABSP("RX",MEDN,"DUR",DUR,476))
- +1 IF '$TEST
- XECUTE SPECIAL(476,DUR)
- +2 QUIT
- 476FMT IF ABSP("X")'=""
- SET ABSP("X")="H6"_$$ANFF^ABSPECFM($GET(ABSP("X")),19)
- +1 QUIT
- 476SET DO FLD476^ABSPOSSG
- +1 QUIT
- COUPON ;EP CALLED FROM ABSPDB1 to set up COUPON SEGMENT
- +1 IF $DATA(SUPRESSG("Coupon"))
- QUIT
- +2 NEW FIELD
- +3 SET RECORD=$GET(RECORD)
- +4 FOR FIELD="111A",485,486,487
- Begin DoDot:1
- +5 IF $DATA(SUPRESF(FIELD))
- QUIT
- +6 IF (ACTION["CLAIM")
- IF (FIELD'=111)
- Begin DoDot:2
- +7 DO @(FIELD_"GET")
- +8 DO @(FIELD_"FMT")
- +9 DO @(FIELD_"SET")
- End DoDot:2
- +10 IF '$TEST
- DO APPEND(FIELD)
- End DoDot:1
- +11 QUIT
- +12 ;Segment identifier
- 111AGET SET ABSP("X")="09"
- +1 QUIT
- 111AFMT SET ABSP("X")=$$ANFF^ABSPECFM(ABSP("X"),2)
- +1 QUIT
- 111ASET ;This isn't used for the 111 Field
- +1 QUIT
- +2 ;Coupon Type
- 485GET IF '$DATA(SPECIAL(485))
- SET ABSP("X")=""
- +1 IF '$TEST
- XECUTE SPECIAL(485)
- +2 QUIT
- 485FMT IF ABSP("X")'=""
- SET ABSP("X")="KE"_$$ANFF^ABSPECFM($GET(ABSP("X")),2)
- +1 QUIT
- 485SET ;Not Yet Implemented
- +1 QUIT
- +2 ;Coupon Number
- 486GET IF '$DATA(SPECIAL(486))
- SET ABSP("X")=""
- +1 IF '$TEST
- XECUTE SPECIAL(486)
- +2 QUIT
- 486FMT IF ABSP("X")'=""
- SET ABSP("X")="ME"_$$ANFF^ABSPECFM($GET(ABSP("X")),15)
- +1 QUIT
- 486SET ;Not Yet Implemented
- +1 QUIT
- +2 ;Coupon Value Amount
- 487GET IF '$DATA(SPECIAL(487))
- SET ABSP("X")=""
- +1 IF '$TEST
- XECUTE SPECIAL(487)
- +2 QUIT
- 487FMT IF ABSP("X")'=""
- SET ABSP("X")="NE"_$$ANFF^ABSPECFM($GET(ABSP("X")),6)
- +1 QUIT
- 487SET ;Not Yet Implemented
- +1 QUIT
- COMPOUND ;EP CALLED FROM ABSPDB1 to set up COMPOUND SEGMENT
- +1 IF $DATA(SUPRESSG("Compound"))
- QUIT
- +2 NEW FIELD
- +3 SET RECORD=$GET(RECORD)
- +4 FOR FIELD="111B",450,451,447,488,489,448,449,490,362,363
- Begin DoDot:1
- +5 IF $DATA(SUPRESF(FIELD))
- QUIT
- +6 IF (ACTION["CLAIM")
- IF (FIELD'=111)
- Begin DoDot:2
- +7 DO @(FIELD_"GET")
- +8 DO @(FIELD_"FMT")
- +9 DO @(FIELD_"SET")
- End DoDot:2
- +10 IF '$TEST
- DO APPEND(FIELD)
- End DoDot:1
- +11 QUIT
- +12 ;Segment identifier
- 111BGET SET ABSP("X")=10
- +1 QUIT
- 111BFMT SET ABSP("X")=$$ANFF^ABSPECFM(ABSP("X"),2)
- +1 QUIT
- 111BSET ;This isn't used for the 111 Field
- +1 QUIT
- +2 ;Compound Dosage Form Description Code
- 450GET IF '$DATA(SPECIAL(450))
- SET ABSP("X")=$GET(ABSP("Compound",ABSP(9002313.0201),"Dosage Form Desc"))
- +1 IF '$TEST
- XECUTE SPECIAL(450)
- +2 QUIT
- 450FMT IF ABSP("X")'=""
- SET ABSP("X")="EF"_$$ANFF^ABSPECFM(ABSP("X"),2)
- +1 QUIT
- 450SET SET $PIECE(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),440),U,10)=ABSP("X")
- +1 QUIT
- +2 ;Compound Dispensing Unit Form Indicator
- 451GET IF '$DATA(SPECIAL(451))
- SET ABSP("X")=$GET(ABSP("Compound",ABSP(9002313.0201),"Disp Unit Form"))
- +1 IF '$TEST
- XECUTE SPECIAL(451)
- +2 QUIT
- 451FMT IF ABSP("X")'=""
- SET ABSP("X")="EG"_$$NFF^ABSPECFM(ABSP("X"),1)
- +1 QUIT
- 451SET SET $PIECE(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),450),U,1)=ABSP("X")
- +1 QUIT
- +2 ;Compound Ingredient Compound Count
- 447GET IF '$DATA(SPECIAL(447))
- SET ABSP("X")=$GET(ABSP("Compound",ABSP(9002313.0201),"Ingred Component Cnt"))
- +1 IF '$TEST
- XECUTE SPECIAL(447)
- +2 QUIT
- 447FMT IF ABSP("X")'=""
- SET ABSP("X")="EC"_$$NFF^ABSPECFM(ABSP("X"),2)
- +1 QUIT
- 447SET SET $PIECE(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),440),U,7)=ABSP("X")
- +1 QUIT
- +2 ;Compound Product ID Qualifier
- 488GET IF '$DATA(SPECIAL(488))
- SET ABSP("X")=$GET(ABSP("Compound","Product ID Qualifier"))
- +1 IF '$TEST
- XECUTE SPECIAL(488)
- +2 QUIT
- 488FMT IF ABSP("X")'=""
- SET ABSP("X")="RE"_$$ANFF^ABSPECFM(ABSP("X"),2)
- +1 QUIT
- 488SET ;Not Yet Implemented
- +1 QUIT
- +2 ;Compound Product ID
- 489GET IF '$DATA(SPECIAL(489))
- SET ABSP("X")=$GET(ABSP("Compound","Product ID"))
- +1 IF '$TEST
- XECUTE SPECIAL(489)
- +2 QUIT
- 489FMT IF ABSP("X")'=""
- SET ABSP("X")="TE"_$$ANFF^ABSPECFM(ABSP("X"),19)
- +1 QUIT
- 489SET ;Not Yet Implemented
- +1 QUIT
- +2 ;Compound Ingredient Quantity
- 448GET IF '$DATA(SPECIAL(448))
- SET ABSP("X")=$GET(ABSP("Coupound","Ingredient Quantity"))
- +1 IF '$TEST
- XECUTE SPECIAL(448)
- +2 QUIT
- 448FMT ;Spec Says Length is 7?
- IF ABSP("X")'=""
- SET ABSP("X")="ED"_$$DFF^ABSPECFM(ABSP("X"),10)
- +1 QUIT
- 448SET ;Not Yet Implemented
- +1 QUIT
- +2 ;Compound Ingredient Drug Cost
- 449GET IF '$DATA(SPECIAL(449))
- SET ABSP("X")=$GET(ABSP("Compound","Ingredient Drug Cost"))
- +1 IF '$TEST
- XECUTE SPECIAL(449)
- +2 QUIT
- 449FMT ;Spec says length is 6?
- IF ABSP("X")'=""
- SET ABSP("X")="EE"_$$DFF^ABSPEFCM(ABSP("X"),8)
- +1 QUIT
- 449SET ;Not Yet Implemented
- +1 QUIT
- +2 ;Compound Ingredient Basis of Cost Determination
- 490GET IF '$DATA(SPECIAL(490))
- SET ABSP("X")=$GET(ABSP("Compound","Ingred Basis of Cost"))
- +1 IF '$TEST
- XECUTE SPECIAL(490)
- +2 QUIT
- 490FMT IF ABSP("X")'=""
- SET ABSP("X")="UE"_$$ANFF^ABSPECFM(ABSP("X"),2)
- +1 QUIT
- 490SET ;Not Yet Implemented
- +1 QUIT
- +2 ;Compound Ingredient Modifier Code Count
- 362GET IF '$DATA(SPECIAL(362))
- SET ABSP("X")=""
- +1 IF '$TEST
- XECUTE SPECIAL(362)
- +2 QUIT
- 362FMT IF ABSP("X")'=""
- SET ABSP("X")="2G"_$$ANFF^ABSPECFM($GET(ABSP("X")),2)
- +1 QUIT
- 362SET ;Not Yet Implemented
- +1 QUIT
- +2 ;Compound Ingredient Modifier Code
- 363GET IF '$DATA(SPECIAL(363))
- SET ABSP("X")=""
- +1 IF '$TEST
- XECUTE SPECIAL(363)
- +2 QUIT
- 363FMT IF ABSP("X")'=""
- SET ABSP("X")="2H"_$$ANFF^ABSPECFM($GET(ABSP("X")),2)
- +1 QUIT
- 363SET ;Not Yet Implemented
- +1 QUIT
- CLINICAL ;EP CALLED FROM ABSPDB1 to set up CLINICAL SEGMENT
- +1 IF $DATA(SUPRESSG("Clinical"))
- QUIT
- +2 NEW RECCNT,DIAG
- +3 IF ACTION["CLAIM"
- Begin DoDot:1
- +4 IF '$DATA(ABSP("RX",MEDN,"DIAG"))
- QUIT
- +5 ;Field 491 is only field on this segment that is not repeating do it first
- +6 DO 491GET
- +7 DO 491FMT
- +8 DO 491SET
- +9 SET (RECCNT,DIAG)=0
- End DoDot:1
- +10
- *** ERROR ***
- +11
- *** ERROR ***
- +12
- *** ERROR ***
- +13
- *** ERROR ***
- +14
- *** ERROR ***
- +15
- *** ERROR ***
- +16
- *** ERROR ***
- +17
- *** ERROR ***
- +18
- *** ERROR ***
- +19
- *** ERROR ***
- +20 IF '$TEST
- Begin DoDot:1
- +21 DO DIAGVAL^ABSPECA1
- +22 IF '$DATA(ABSP(9002313.0701))
- QUIT
- +23 ;Only two non repeating fields (111, 491)
- DO APPEND("111C")
- +24 SET ABSP("X")=$GET(ABSP(9002313.0701,0,491,"I"))
- +25 SET RECCNT=+$EXTRACT(ABSP("X"),3,4)
- +26 SET RECORD=RECORD_$CHAR(28)_ABSP("X")
- +27 FOR DIAG=1:1:RECCNT
- Begin DoDot:2
- +28 FOR FIELD=492,424,493,494,495,496,497,499
- Begin DoDot:3
- +29 IF $DATA(SUPRESF(FIELD))
- QUIT
- +30 SET ABSP("X")=$GET(ABSP(9002313.0701,DIAG,FIELD,"I"))
- +31 IF ABSP("X")'=""
- SET RECORD=RECORD_$CHAR(28)_ABSP("X")
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +32 QUIT
- +33 ;Segment identifier
- 111CGET SET ABSP("X")=13
- +1 QUIT
- 111CFMT SET ABSP("X")=$$ANFF^ABSPECFM(ABSP("X"),2)
- +1 QUIT
- 111CSET ;This isn't used for the 111 Field
- +1 QUIT
- +2 ;Diagnosis Code Count
- 491GET IF '$DATA(SPECIAL(491))
- SET ABSP("X")=$GET(ABSP("RX",MEDN,"DIAG",0,491))
- +1 IF '$TEST
- XECUTE SPECIAL(491)
- +2 QUIT
- 491FMT IF ABSP("X")'=""
- SET ABSP("X")="VE"_$$NFF^ABSPECFM(ABSP("X"),1)
- +1 QUIT
- 491SET DO FLD491^ABSPOSSH
- +1 QUIT
- +2 ;Diagnosis Code Qualifer
- 492GET IF '$DATA(SPECIAL(492,DIAG))
- SET ABSP("X")=$GET(ABSP("RX",MEDN,"DIAG",DIAG,492))
- +1 IF '$TEST
- XECUTE SPECIAL(492,DIAG)
- +2 QUIT
- 492FMT IF ABSP("X")'=""
- SET ABSP("X")="WE"_$$ANFF^ABSPECFM(ABSP("X"),2)
- +1 QUIT
- 492SET DO FLD492^ABSPOSSH
- +1 QUIT
- +2 ;Diagnosis Code
- 424GET IF '$DATA(SPECIAL(424,DIAG))
- SET ABSP("X")=$GET(ABSP("RX",MEDN,"DIAG",DIAG,424))
- +1 IF '$TEST
- XECUTE SPECIAL(424,DIAG)
- +2 QUIT
- 424FMT NEW INSIEN,REMOVE
- +1 IF ABSP("X")'=""
- IF $EXTRACT(ABSP("X"),$LENGTH(ABSP("X")))="."
- SET ABSP("X")=$EXTRACT(ABSP("X"),1,$LENGTH(ABSP("X")-1))
- +2 ; /IHS/OIT/RAM ; 28 SEP 17 ;P49-CR09768, ADD OVERALL FORMATTING CODE TO INSURER OVERRIDE SYSTEM.
- IF ($DATA(SPECIAL(424))#10)=1
- XECUTE SPECIAL(424)
- +3 SET INSIEN=+$GET(ABSP("Insurer","IEN"))
- SET REMOVE=0
- +4 IF INSIEN>0
- SET REMOVE=+$PIECE($GET(^ABSPEI(INSIEN,"ICD10")),"^",2)
- +5 IF REMOVE
- SET ABSP("X")=$TRANSLATE($GET(ABSP("X")),".","")
- +6 IF ABSP("X")'=""
- SET ABSP("X")="DO"_$$ANFF^ABSPECFM($GET(ABSP("X")),15)
- +7 QUIT
- 424SET DO FLD424^ABSPOSSH
- +1 QUIT
- +2 ;Clinical Information Counter
- 493GET IF '$DATA(SPECIAL(493,DIAG))
- SET ABSP("X")=$GET(ABSP("Clinical",ABSP(9002313.0201),"Information Cntr"))
- +1 IF '$TEST
- XECUTE SPECIAL(493,DIAG)
- +2 QUIT
- 493FMT IF ABSP("X")'=""
- SET ABSP("X")="XE"_$$NFF^ABSPECFM(ABSP("X"),2)
- +1 QUIT
- 493SET SET $PIECE(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),490),U,3)=ABSP("X")
- +1 QUIT
- +2 ;Measurement Date
- 494GET IF '$DATA(SPECIAL(494,DIAG))
- Begin DoDot:1
- +1 SET ABSP("X")=$GET(ABSP("RX",MEDN,"DIAG",DIAG,494))
- +2 IF ABSP("X")=""
- SET ABSP("X")=$GET(ABSP("Clinical","Measurement Date"))
- End DoDot:1
- +3 IF '$TEST
- XECUTE SPECIAL(494,DIAG)
- +4 QUIT
- 494FMT IF ABSP("X")'=""
- SET ABSP("X")="ZE"_$$NFF^ABSPECFM(ABSP("X"),8)
- +1 QUIT
- 494SET ;Not Yet Implemented
- +1 QUIT
- +2 ;Measurement Time
- 495GET IF '$DATA(SPECIAL(495,DIAG))
- Begin DoDot:1
- +1 SET ABSP("X")=$GET(ABSP("RX",MEDN,"DIAG",DIAG,495))
- +2 IF ABSP("X")=""
- SET ABSP("X")=$GET(ABSP("Clinical","Measurement Time"))
- End DoDot:1
- +3 IF '$TEST
- XECUTE SPECIAL(495,DIAG)
- +4 QUIT
- 495FMT IF ABSP("X")'=""
- SET ABSP("X")="H1"_$$NFF^ABSPECFM(ABSP("X"),4)
- +1 QUIT
- 495SET ;Not Yet Implemented
- +1 QUIT
- +2 ;Measurement Dimension
- 496GET IF '$DATA(SPECIAL(496,DIAG))
- Begin DoDot:1
- +1 SET ABSP("X")=$GET(ABSP("RX",MEDN,"DIAG",DIAG,496))
- +2 IF ABSP("X")=""
- SET ABSP("X")=$GET(ABSP("Clinical","Measurement Dimension"))
- End DoDot:1
- +3 IF '$TEST
- XECUTE SPECIAL(496,DIAG)
- +4 QUIT
- 496FMT IF ABSP("X")'=""
- SET ABSP("X")="H2"_$$ANFF^ABSPECFM(ABSP("X"),2)
- +1 QUIT
- 496SET ;Not Yet Implemented
- +1 QUIT
- +2 ;Measurement Unit
- 497GET IF '$DATA(SPECIAL(497,DIAG))
- Begin DoDot:1
- +1 SET ABSP("X")=$GET(ABSP("RX",MEDN,"DIAG",DIAG,497))
- +2 IF ABSP("X")=""
- SET ABSP("X")=$GET(ABSP("Clinical","Measurement Unit"))
- End DoDot:1
- +3 IF '$TEST
- XECUTE SPECIAL(497,DIAG)
- +4 QUIT
- 497FMT IF ABSP("X")'=""
- SET ABSP("X")="H3"_$$ANFF^ABSPECFM(ABSP("X"),2)
- +1 QUIT
- 497SET ;Not Yet Implemented
- +1 QUIT
- +2 ;Measurement Value
- 499GET IF '$DATA(SPECIAL(499,DIAG))
- Begin DoDot:1
- +1 SET ABSP("X")=$GET(ABSP("RX",MEDN,"DIAG",DIAG,499))
- +2 IF ABSP("X")=""
- SET ABSP("X")=$GET(ABSP("Clinical","Measurement Value"))
- End DoDot:1
- +3 IF '$TEST
- XECUTE SPECIAL(499,DIAG)
- +4 QUIT
- 499FMT IF ABSP("X")'=""
- SET ABSP("X")="H4"_$$ANFF^ABSPECFM(ABSP("X"),15)
- +1 QUIT
- 499SET ;Not Yet Implemented
- +1 QUIT
- APPEND(FIELD) ;This is where the record is built field by field
- +1 IF FIELD["111"
- Begin DoDot:1
- +2 DO @(FIELD_"GET")
- +3 DO @(FIELD_"FMT")
- +4 SET RECORD=RECORD_$CHAR(30,28)_"AM"_ABSP("X")
- End DoDot:1
- +5 IF '$TEST
- Begin DoDot:1
- +6 IF $GET(ABSP(9002313.0201,IEN(9002313.01),FIELD,"I"))'=""
- SET RECORD=RECORD_$CHAR(28)_$GET(ABSP(9002313.0201,IEN(9002313.01),FIELD,"I"))
- +7 IF '$TEST
- IF $DATA(SPECIAL(FIELD))
- Begin DoDot:2
- +8 XECUTE SPECIAL(FIELD)
- +9 DO @(FIELD_"FMT")
- +10 SET RECORD=RECORD_$CHAR(28)_ABSP("X")
- End DoDot:2
- End DoDot:1
- +11 QUIT
