- ABSP5B2 ; IHS/OIT/CASSevern/Pieran ran 1/19/2011 - Handling of NCPDP Reversal "B2" Claims for 5.1
- ;;1.0;PHARMACY POINT OF SALE;**42,43**;JUN 21, 2001;Build 38
- ;
- ;
- ; SO FAR THIS IS JUST A COPY OF ABSPB1 "BILLING" TRANSACTION....MOST OF BELOW CODE WILL BE REPLACED!!!
- ; This routine will replace the ABSPOSCF for 5.1, so that we no
- ; longer need to use the formats file.
- ; This will go through and get the data for each and every segment and field
- ; format it and place it in the CLAIM file ^ABSPC(CLAIMIEN
- ; The ABSP() Array is already set up in: GETINFO^ABSPOSCC before we get here.
- ;INPUT = ACTION
- ; "CLAIMHD" = Set up only the claim header for creating ^ABSPC entry
- ; "CLAIMRST" = Set up Rest of Claim info and fill in ^ABSPC entry
- ; "OUTHD" = Create the actual Output HEADER Record
- ; "OUTRST" = Create the actual Output Rest of the Record.
- EN(ACTION,MEDN,IEN) ;EP
- N INSARRAY,DO,SPECIAL,SUPPRESS
- S RECORD=$G(RECORD)
- I ACTION["CLAIM" D
- . S DO=ABSP("Insurer","IEN")_","
- ELSE D
- . S DO=IEN("9002313.4")_","
- D GETS^DIQ(9002313.4,DO,"100.15;100.16;100.17;200.01;210*;215*;220*","","INSARRAY")
- I $D(INSARRAY(9002313.42)) D SETSPEC
- I $D(INSARRAY(9002313.46)) D SETSUPR
- D CHECKOVER^ABSP5B1F(D0,.SPECIAL) ;Check for Manual Over-Rides for this Claim
- ;I $D(SPECIAL) D ADDSEG^ABSPB1F(.SPECIAL,.ADDSEG) ;Figure out based on Special fields which segments we need
- I (ACTION="CLAIMHD")!(ACTION="OUTHD") D
- . D HEADER ;Every time
- . D INSURANCE ;Every time;IHS/OIT/CASSevern/Pieran/RCS; Patch 43 - Add back in
- I (ACTION="CLAIMRST")!(ACTION="OUTRST") D
- . I +$G(IEN(9002313.01))=0 S IEN(9002313.01)=1
- . D CLAIM^ABSP5B2A ;Every time
- . ;D PRICING^ABSP5B2A ;Pretty much every time
- . I $D(ADDSEG("DURRPPS")) D DURRPPS^ABSP5B2A ;Very common...but for over-rides only
- Q
- ;Go through field by field and construct the Header
- ;The header is the one segment that is completely unchanged between version 5.1 and D.0
- ;The only difference is field 102 "VERSION" now says D0 instead of 51
- N FIELD
- F FIELD=101,102,103,104,109,202,201,401,110 D
- . Q:$D(SUPPRESS(FIELD))
- . I (ACTION["CLAIM"),(FIELD'=111) D
- . . D @(FIELD_"GET")
- . . D @(FIELD_"FMT")
- . . D @(FIELD_"SET")
- . ELSE D @(FIELD_"APD")
- Q
- ;BIN #
- 101GET I '$D(SPECIAL(101)) S ABSP("X")=$G(INSARRAY(9002313.4,DO,100.16))
- ELSE X SPECIAL(101)
- Q
- 101FMT S ABSP("X")=$$NFF^ABSPECFM(ABSP("X"),6)
- Q
- 101SET S $P(^ABSPC(ABSP(9002313.02),100),U,1)=ABSP("X")
- Q
- 101APD S RECORD=$G(ABSP(9002313.02,MEDN,FIELD,"I"))
- Q
- ;VERSION (5.1, D.0)
- 102GET S ABSP("X")=$TR($G(INSARRAY(9002313.4,DO,100.15)),".","")
- Q
- 102FMT S ABSP("X")=$$ANFF^ABSPECFM(ABSP("X"),2)
- Q
- 102SET S $P(^ABSPC(ABSP(9002313.02),100),U,2)=ABSP("X")
- Q
- 102APD S RECORD=RECORD_$G(ABSP(9002313.02,MEDN,FIELD,"I"))
- Q
- ;TRANSACTION CODE "B2" for Reversal
- 103GET S ABSP("X")="B2"
- Q
- 103FMT S ABSP("X")=$$ANFF^ABSPECFM(ABSP("X"),2)
- Q
- 103SET S $P(^ABSPC(ABSP(9002313.02),100),U,3)=ABSP("X")
- Q
- 103APD S RECORD=RECORD_"B2"
- Q
- ;PCN #
- 104GET I '$D(SPECIAL(104)) S ABSP("X")=$G(INSARRAY(9002313.4,DO,100.17))
- ELSE X SPECIAL(104)
- Q
- 104FMT S ABSP("X")=$$ANFF^ABSPECFM(ABSP("X"),10)
- Q
- 104SET S $P(^ABSPC(ABSP(9002313.02),100),U,4)=ABSP("X")
- Q
- 104APD S RECORD=RECORD_$G(ABSP(9002313.02,MEDN,FIELD,"I"))
- Q
- ;Transaction count
- 109GET I '$D(SPECIAL(109)) S ABSP("X")=1 ;IHS/OIT/CASSevern/Pieran/RCS; Patch 43 - Force to a '1'
- ELSE X SPECIAL(109)
- Q
- 109FMT S ABSP("X")=$$ANFF^ABSPECFM(ABSP("X"),1)
- Q
- 109SET S $P(^ABSPC(ABSP(9002313.02),100),U,9)=ABSP("X")
- Q
- 109APD S RECORD=RECORD_1 ;IHS/OIT/CASSevern/Pieran/RCS; Patch 43 - Force to '1'
- Q
- ;Service provider ID
- 202GET I '$D(SPECIAL(202)) S ABSP("X")=$G(ABSP("Header","Service Prov ID Qual"))
- ELSE X SPECIAL(202)
- Q
- 202FMT S ABSP("X")=$$ANFF^ABSPECFM($G(ABSP("X")),2)
- Q
- 202SET S $P(^ABSPC(ABSP(9002313.02),200),U,2)=ABSP("X")
- Q
- 202APD S RECORD=RECORD_$G(ABSP(9002313.02,MEDN,FIELD,"I"))
- Q
- ;Pharmacy number
- 201GET I '$D(SPECIAL(201)) S ABSP("X")=$G(ABSP("Site","Pharmacy #"))
- ELSE X SPECIAL(201)
- Q
- 201FMT S ABSP("X")=$$ANFF^ABSPECFM(ABSP("X"),15)
- Q
- 201SET S $P(^ABSPC(ABSP(9002313.02),200),U,1)=ABSP("X")
- Q
- 201APD S RECORD=RECORD_$G(ABSP(9002313.02,MEDN,FIELD,"I"))
- Q
- ;Fill Date
- 401GET I '$D(SPECIAL(401)) S ABSP("X")=$G(ABSP("RX","Date Filled"))
- ELSE X SPECIAL(401)
- Q
- 401FMT S ABSP("X")=$$NFF^ABSPECFM($$DTF1^ABSPECFM(ABSP("X")),8)
- Q
- 401SET S $P(^ABSPC(ABSP(9002313.02),401),U,1)=ABSP("X")
- Q
- 401APD S RECORD=RECORD_$G(ABSP(9002313.02,MEDN,FIELD,"I"))
- Q
- ;Vendor ID
- 110GET I '$D(SPECIAL(110)) S ABSP("X")=$G(ABSP("Software Vendor"))
- ELSE X SPECIAL(110)
- Q
- 110FMT S ABSP("X")=$$ANFF^ABSPECFM($G(ABSP("X")),10)
- Q
- 110SET S $P(^ABSPC(ABSP(9002313.02),100),U,10)=ABSP("X")
- Q
- 110APD S RECORD=RECORD_$G(ABSP(9002313.02,MEDN,FIELD,"I"))
- Q
- INSURANCE ;INSURANCE Segment
- N FIELD
- S RECORD=$G(RECORD)
- F FIELD="111",302,301,359 D
- . Q:$D(SUPPRESS(FIELD))
- . I (ACTION["CLAIM"),(FIELD'=111) D
- . . D @(FIELD_"GET")
- . . D @(FIELD_"FMT")
- . . D @(FIELD_"SET")
- . ELSE D APPEND(FIELD)
- Q
- ;Segment identifier
- 111GET S ABSP("X")="04"
- Q
- 111FMT S ABSP("X")=$$ANFF^ABSPECFM(ABSP("X"),2)
- Q
- 111SET ;This isn't used for the 111 Field
- Q
- ;Cardholder ID
- 302GET I '$D(SPECIAL(302)) S ABSP("X")=$G(ABSP("Insurer","Policy #"))
- ELSE X SPECIAL(302)
- Q
- 302FMT S:ABSP("X")'="" ABSP("X")="C2"_$$ANFF^ABSPECFM($G(ABSP("X")),20)
- Q
- 302SET S $P(^ABSPC(ABSP(9002313.02),300),U,2)=ABSP("X")
- Q
- ;Group ID
- 301GET I '$D(SPECIAL(301)) S ABSP("X")=$G(ABSP("Insurer","Group #"))
- ELSE X SPECIAL(301)
- Q
- 301FMT S:ABSP("X")'="" ABSP("X")="C1"_$$ANFF^ABSPECFM(ABSP("X"),15)
- Q
- 301SET S $P(^ABSPC(ABSP(9002313.02),300),U,1)=ABSP("X")
- Q
- ;Medigap ID
- 359GET I '$D(SPECIAL(359)) S ABSP("X")=""
- ELSE X SPECIAL(359)
- Q
- 359FMT S:ABSP("X")'="" ABSP("X")="2A"_$$ANFF^ABSPECFM($G(ABSP("X")),20)
- Q
- 359SET ;Not Yet Implemented **
- Q
- SETSPEC ;SET UP SPECIAL CODE ARRAY HERE.
- N D1,NCODE,MUMPS
- S D1=""
- F S D1=$O(INSARRAY(9002313.42,D1)) Q:D1="" D
- . S NCODE=$G(INSARRAY(9002313.42,D1,.01))
- . S MUMPS=$G(INSARRAY(9002313.42,D1,.02))
- . I MUMPS'["ABSP(""X"")" S MUMPS="S ABSP(""X"")="""_MUMPS_""""
- . S SPECIAL(NCODE)=MUMPS
- Q
- SETSUPR ;SET UP SUPPRESS CODE ARRAY HERE
- N D1,SCODE
- S D1=""
- F S D1=$O(INSARRAY(9002313.46,D1)) Q:D1="" D
- . S SCODE=$G(INSARRAY(9002313.46,D1,.01))
- . S SUPPRESS(SCODE)=""
- Q
- APPEND(FIELD) ;This is where outgoing 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.02,MEDN,FIELD,"I"))'="" S RECORD=RECORD_$C(28)_$G(ABSP(9002313.02,MEDN,FIELD,"I"))
- . ELSE I $D(SPECIAL(FIELD)) D
- . . X SPECIAL(FIELD)
- . . D @(FIELD_"FMT")
- . . S RECORD=RECORD_$C(28)_ABSP("X")
- Q
- ABSP5B2 ; IHS/OIT/CASSevern/Pieran ran 1/19/2011 - Handling of NCPDP Reversal "B2" Claims for 5.1
- +1 ;;1.0;PHARMACY POINT OF SALE;**42,43**;JUN 21, 2001;Build 38
- +2 ;
- +3 ;
- +4 ; SO FAR THIS IS JUST A COPY OF ABSPB1 "BILLING" TRANSACTION....MOST OF BELOW CODE WILL BE REPLACED!!!
- +5 ; This routine will replace the ABSPOSCF for 5.1, so that we no
- +6 ; longer need to use the formats file.
- +7 ; This will go through and get the data for each and every segment and field
- +8 ; format it and place it in the CLAIM file ^ABSPC(CLAIMIEN
- +9 ; The ABSP() Array is already set up in: GETINFO^ABSPOSCC before we get here.
- +10 ;INPUT = ACTION
- +11 ; "CLAIMHD" = Set up only the claim header for creating ^ABSPC entry
- +12 ; "CLAIMRST" = Set up Rest of Claim info and fill in ^ABSPC entry
- +13 ; "OUTHD" = Create the actual Output HEADER Record
- +14 ; "OUTRST" = Create the actual Output Rest of the Record.
- EN(ACTION,MEDN,IEN) ;EP
- +1 NEW INSARRAY,DO,SPECIAL,SUPPRESS
- +2 SET RECORD=$GET(RECORD)
- +3 IF ACTION["CLAIM"
- Begin DoDot:1
- +4 SET DO=ABSP("Insurer","IEN")_","
- End DoDot:1
- +5 IF '$TEST
- Begin DoDot:1
- +6 SET DO=IEN("9002313.4")_","
- End DoDot:1
- +7 DO GETS^DIQ(9002313.4,DO,"100.15;100.16;100.17;200.01;210*;215*;220*","","INSARRAY")
- +8 IF $DATA(INSARRAY(9002313.42))
- DO SETSPEC
- +9 IF $DATA(INSARRAY(9002313.46))
- DO SETSUPR
- +10 ;Check for Manual Over-Rides for this Claim
- DO CHECKOVER^ABSP5B1F(D0,.SPECIAL)
- +11 ;I $D(SPECIAL) D ADDSEG^ABSPB1F(.SPECIAL,.ADDSEG) ;Figure out based on Special fields which segments we need
- +12 IF (ACTION="CLAIMHD")!(ACTION="OUTHD")
- Begin DoDot:1
- +13 ;Every time
- DO HEADER
- +14 ;Every time;IHS/OIT/CASSevern/Pieran/RCS; Patch 43 - Add back in
- DO INSURANCE
- End DoDot:1
- +15 IF (ACTION="CLAIMRST")!(ACTION="OUTRST")
- Begin DoDot:1
- +16 IF +$GET(IEN(9002313.01))=0
- SET IEN(9002313.01)=1
- +17 ;Every time
- DO CLAIM^ABSP5B2A
- +18 ;D PRICING^ABSP5B2A ;Pretty much every time
- +19 ;Very common...but for over-rides only
- IF $DATA(ADDSEG("DURRPPS"))
- DO DURRPPS^ABSP5B2A
- End DoDot:1
- +20 QUIT
- +21 ;Go through field by field and construct the Header
- +22 ;The header is the one segment that is completely unchanged between version 5.1 and D.0
- +23 ;The only difference is field 102 "VERSION" now says D0 instead of 51
- +1 NEW FIELD
- +2 FOR FIELD=101,102,103,104,109,202,201,401,110
- Begin DoDot:1
- +3 IF $DATA(SUPPRESS(FIELD))
- QUIT
- +4 IF (ACTION["CLAIM")
- IF (FIELD'=111)
- Begin DoDot:2
- +5 DO @(FIELD_"GET")
- +6 DO @(FIELD_"FMT")
- +7 DO @(FIELD_"SET")
- End DoDot:2
- +8 IF '$TEST
- DO @(FIELD_"APD")
- End DoDot:1
- +9 QUIT
- +10 ;BIN #
- 101GET IF '$DATA(SPECIAL(101))
- SET ABSP("X")=$GET(INSARRAY(9002313.4,DO,100.16))
- +1 IF '$TEST
- XECUTE SPECIAL(101)
- +2 QUIT
- 101FMT SET ABSP("X")=$$NFF^ABSPECFM(ABSP("X"),6)
- +1 QUIT
- 101SET SET $PIECE(^ABSPC(ABSP(9002313.02),100),U,1)=ABSP("X")
- +1 QUIT
- 101APD SET RECORD=$GET(ABSP(9002313.02,MEDN,FIELD,"I"))
- +1 QUIT
- +2 ;VERSION (5.1, D.0)
- 102GET SET ABSP("X")=$TRANSLATE($GET(INSARRAY(9002313.4,DO,100.15)),".","")
- +1 QUIT
- 102FMT SET ABSP("X")=$$ANFF^ABSPECFM(ABSP("X"),2)
- +1 QUIT
- 102SET SET $PIECE(^ABSPC(ABSP(9002313.02),100),U,2)=ABSP("X")
- +1 QUIT
- 102APD SET RECORD=RECORD_$GET(ABSP(9002313.02,MEDN,FIELD,"I"))
- +1 QUIT
- +2 ;TRANSACTION CODE "B2" for Reversal
- 103GET SET ABSP("X")="B2"
- +1 QUIT
- 103FMT SET ABSP("X")=$$ANFF^ABSPECFM(ABSP("X"),2)
- +1 QUIT
- 103SET SET $PIECE(^ABSPC(ABSP(9002313.02),100),U,3)=ABSP("X")
- +1 QUIT
- 103APD SET RECORD=RECORD_"B2"
- +1 QUIT
- +2 ;PCN #
- 104GET IF '$DATA(SPECIAL(104))
- SET ABSP("X")=$GET(INSARRAY(9002313.4,DO,100.17))
- +1 IF '$TEST
- XECUTE SPECIAL(104)
- +2 QUIT
- 104FMT SET ABSP("X")=$$ANFF^ABSPECFM(ABSP("X"),10)
- +1 QUIT
- 104SET SET $PIECE(^ABSPC(ABSP(9002313.02),100),U,4)=ABSP("X")
- +1 QUIT
- 104APD SET RECORD=RECORD_$GET(ABSP(9002313.02,MEDN,FIELD,"I"))
- +1 QUIT
- +2 ;Transaction count
- 109GET ;IHS/OIT/CASSevern/Pieran/RCS; Patch 43 - Force to a '1'
- IF '$DATA(SPECIAL(109))
- SET ABSP("X")=1
- +1 IF '$TEST
- XECUTE SPECIAL(109)
- +2 QUIT
- 109FMT SET ABSP("X")=$$ANFF^ABSPECFM(ABSP("X"),1)
- +1 QUIT
- 109SET SET $PIECE(^ABSPC(ABSP(9002313.02),100),U,9)=ABSP("X")
- +1 QUIT
- 109APD ;IHS/OIT/CASSevern/Pieran/RCS; Patch 43 - Force to '1'
- SET RECORD=RECORD_1
- +1 QUIT
- +2 ;Service provider ID
- 202GET IF '$DATA(SPECIAL(202))
- SET ABSP("X")=$GET(ABSP("Header","Service Prov ID Qual"))
- +1 IF '$TEST
- XECUTE SPECIAL(202)
- +2 QUIT
- 202FMT SET ABSP("X")=$$ANFF^ABSPECFM($GET(ABSP("X")),2)
- +1 QUIT
- 202SET SET $PIECE(^ABSPC(ABSP(9002313.02),200),U,2)=ABSP("X")
- +1 QUIT
- 202APD SET RECORD=RECORD_$GET(ABSP(9002313.02,MEDN,FIELD,"I"))
- +1 QUIT
- +2 ;Pharmacy number
- 201GET IF '$DATA(SPECIAL(201))
- SET ABSP("X")=$GET(ABSP("Site","Pharmacy #"))
- +1 IF '$TEST
- XECUTE SPECIAL(201)
- +2 QUIT
- 201FMT SET ABSP("X")=$$ANFF^ABSPECFM(ABSP("X"),15)
- +1 QUIT
- 201SET SET $PIECE(^ABSPC(ABSP(9002313.02),200),U,1)=ABSP("X")
- +1 QUIT
- 201APD SET RECORD=RECORD_$GET(ABSP(9002313.02,MEDN,FIELD,"I"))
- +1 QUIT
- +2 ;Fill Date
- 401GET IF '$DATA(SPECIAL(401))
- SET ABSP("X")=$GET(ABSP("RX","Date Filled"))
- +1 IF '$TEST
- XECUTE SPECIAL(401)
- +2 QUIT
- 401FMT SET ABSP("X")=$$NFF^ABSPECFM($$DTF1^ABSPECFM(ABSP("X")),8)
- +1 QUIT
- 401SET SET $PIECE(^ABSPC(ABSP(9002313.02),401),U,1)=ABSP("X")
- +1 QUIT
- 401APD SET RECORD=RECORD_$GET(ABSP(9002313.02,MEDN,FIELD,"I"))
- +1 QUIT
- +2 ;Vendor ID
- 110GET IF '$DATA(SPECIAL(110))
- SET ABSP("X")=$GET(ABSP("Software Vendor"))
- +1 IF '$TEST
- XECUTE SPECIAL(110)
- +2 QUIT
- 110FMT SET ABSP("X")=$$ANFF^ABSPECFM($GET(ABSP("X")),10)
- +1 QUIT
- 110SET SET $PIECE(^ABSPC(ABSP(9002313.02),100),U,10)=ABSP("X")
- +1 QUIT
- 110APD SET RECORD=RECORD_$GET(ABSP(9002313.02,MEDN,FIELD,"I"))
- +1 QUIT
- INSURANCE ;INSURANCE Segment
- +1 NEW FIELD
- +2 SET RECORD=$GET(RECORD)
- +3 FOR FIELD="111",302,301,359
- Begin DoDot:1
- +4 IF $DATA(SUPPRESS(FIELD))
- QUIT
- +5 IF (ACTION["CLAIM")
- IF (FIELD'=111)
- Begin DoDot:2
- +6 DO @(FIELD_"GET")
- +7 DO @(FIELD_"FMT")
- +8 DO @(FIELD_"SET")
- End DoDot:2
- +9 IF '$TEST
- DO APPEND(FIELD)
- End DoDot:1
- +10 QUIT
- +11 ;Segment identifier
- 111GET SET ABSP("X")="04"
- +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 ;Cardholder ID
- 302GET IF '$DATA(SPECIAL(302))
- SET ABSP("X")=$GET(ABSP("Insurer","Policy #"))
- +1 IF '$TEST
- XECUTE SPECIAL(302)
- +2 QUIT
- 302FMT IF ABSP("X")'=""
- SET ABSP("X")="C2"_$$ANFF^ABSPECFM($GET(ABSP("X")),20)
- +1 QUIT
- 302SET SET $PIECE(^ABSPC(ABSP(9002313.02),300),U,2)=ABSP("X")
- +1 QUIT
- +2 ;Group ID
- 301GET IF '$DATA(SPECIAL(301))
- SET ABSP("X")=$GET(ABSP("Insurer","Group #"))
- +1 IF '$TEST
- XECUTE SPECIAL(301)
- +2 QUIT
- 301FMT IF ABSP("X")'=""
- SET ABSP("X")="C1"_$$ANFF^ABSPECFM(ABSP("X"),15)
- +1 QUIT
- 301SET SET $PIECE(^ABSPC(ABSP(9002313.02),300),U,1)=ABSP("X")
- +1 QUIT
- +2 ;Medigap ID
- 359GET IF '$DATA(SPECIAL(359))
- SET ABSP("X")=""
- +1 IF '$TEST
- XECUTE SPECIAL(359)
- +2 QUIT
- 359FMT IF ABSP("X")'=""
- SET ABSP("X")="2A"_$$ANFF^ABSPECFM($GET(ABSP("X")),20)
- +1 QUIT
- 359SET ;Not Yet Implemented **
- +1 QUIT
- SETSPEC ;SET UP SPECIAL CODE ARRAY HERE.
- +1 NEW D1,NCODE,MUMPS
- +2 SET D1=""
- +3 FOR
- SET D1=$ORDER(INSARRAY(9002313.42,D1))
- IF D1=""
- QUIT
- Begin DoDot:1
- +4 SET NCODE=$GET(INSARRAY(9002313.42,D1,.01))
- +5 SET MUMPS=$GET(INSARRAY(9002313.42,D1,.02))
- +6 IF MUMPS'["ABSP(""X"")"
- SET MUMPS="S ABSP(""X"")="""_MUMPS_""""
- +7 SET SPECIAL(NCODE)=MUMPS
- End DoDot:1
- +8 QUIT
- SETSUPR ;SET UP SUPPRESS CODE ARRAY HERE
- +1 NEW D1,SCODE
- +2 SET D1=""
- +3 FOR
- SET D1=$ORDER(INSARRAY(9002313.46,D1))
- IF D1=""
- QUIT
- Begin DoDot:1
- +4 SET SCODE=$GET(INSARRAY(9002313.46,D1,.01))
- +5 SET SUPPRESS(SCODE)=""
- End DoDot:1
- +6 QUIT
- APPEND(FIELD) ;This is where outgoing 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.02,MEDN,FIELD,"I"))'=""
- SET RECORD=RECORD_$CHAR(28)_$GET(ABSP(9002313.02,MEDN,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