Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ABSPECP3

ABSPECP3.m

Go to the documentation of this file. 
  1. ABSPECP3 ; IHS/FCS/DRS - Receipts ;  [ 09/19/2002  10:16 AM ]
  1.  ;;1.0;PHARMACY POINT OF SALE;**3,42**;JUN 21, 2001;Build 38
  1.  ;
  1.  ;-----------------------------------------------------------------
  1.  ;IHS/SD/lwj 9/19/02  NCPDP 5.1 changes
  1.  ; There were many, many changes with the coming of NCPDP 5.1.  One
  1.  ; is that 42% of the existing claim fields, and 50% of the existing
  1.  ; result fields changed field type, value types, and field names.
  1.  ; The changes in field names cause this program a little grief 
  1.  ; so adjustments were made accordingly.
  1.  ;
  1.  ;
  1.  ;-----------------------------------------------------------------
  1.  ;
  1.  Q
  1.  ; TMP("C",field)=value for claim header
  1.  ; TMP("C",field,"RX",n)=values for claim medication
  1.  ; TMP("R",field)=values for claim response
  1.  ; TMP("R",field,"RX",n)=values for medication responses
  1.  Q
  1.  ;
  1.  ; * BEGIN * for file 9002313.99, Field RECEIPT STYLE
  1. RECEIPT ;EP - from ABSPECP0, RECEIPT^ABSPOS6E
  1.  N SRC S SRC="TMP"
  1.  D FULL() Q
  1. FULL0 ;EP - from ABSPECP0
  1.  W " - RECEIPT -",!
  1.  D PRINT("TMP","PCS1") Q
  1. ANMC ;
  1.  ; Write any kind of page header here
  1.  D PRINT("TMP","ANMC1")
  1.  Q
  1.  ; * END * of receipt styles
  1.  ;
  1. TEST ;O 51:("TMP.OUT":"W") U 51 S SRC="TMP" D FULL() C 51 Q
  1. FULL(DIV,LEV,RX) ; print it all    
  1.  ;  WHAT YOU'RE LOOKING FOR PROBABLY IS NOT HERE
  1.  ;  LOOK BELOW, AT "PRINTSEG" INSTEAD!!!!!!!!!!!
  1.  ; recurse, filling in parameters
  1.  I '$D(DIV) D FULL("C"),FULL("R") Q
  1.  I '$D(LEV) D  D FULL(DIV,0) Q  ; header, then prescription come at end
  1.  .W " = = = = = ",$S(DIV="C":"CLAIM",DIV="R":"RESPONSE")," = = = = =",!
  1.  ;
  1.  ;IHS/SD/lwj  9/19/02  NCPDP 5.1  Prescription Number is now called
  1.  ; Prescription/Service Ref Num - within the do loop one line
  1.  ; was commented out and the next 2 lines were added to adjust for chg.
  1.  ;
  1.  I $G(LEV)=1,'$D(RX) D  Q
  1.  .;S RX=0 F  S RX=$O(@SRC@("C","Prescription Number","RX",RX)) Q:'RX  D
  1.  .S RX=0
  1.  .F  S RX=$O(@SRC@("C","Prescription/Service Ref Num","RX",RX)) Q:'RX  D
  1.  ..;W " * TMP * Prescription Number ",RX," * TMP * ",!
  1.  ..D FULL(DIV,LEV,RX)
  1.  I '$D(IOM) N IOM S IOM=80
  1.  N FIELD,TITLE,VALUE
  1.  S FIELD="" F  S FIELD=$O(@SRC@(DIV,FIELD)) Q:FIELD=""  D
  1.  .;W "LEV=",LEV,",FIELD=",FIELD,!
  1.  .I LEV=0,$D(@SRC@(DIV,FIELD))>9 Q  ; header skips prescription fields
  1.  .I LEV=1,$D(@SRC@(DIV,FIELD))<9 Q  ; prescription skips header fields
  1.  .; Specialized titles are done here
  1.  .I 0
  1.  .E  S TITLE=FIELD_": "
  1.  .N OUTPUT
  1.  .I LEV=0 S VALUE=@SRC@(DIV,FIELD),OUTPUT=1
  1.  .;I LEV=1 ZW DIV,FIELD,RX R ">>",%,!
  1.  .I LEV=1 D
  1.  ..I FIELD="Reject Code" D  S OUTPUT=0 Q
  1.  ...N X,I S X="" F I=0:1 S X=$O(@SRC@(DIV,FIELD,"RX",RX,X)) Q:X=""  D
  1.  ....S VALUE=@SRC@(DIV,FIELD,"RX",RX,X)
  1.  ....S TITLE="Reject code: "
  1.  ....D OUTPUT
  1.  ..I FIELD="NDC Number" D  S OUTPUT=0 Q
  1.  ...S VALUE=$$FORMTNDC^ABSPOS9($TR(@SRC@(DIV,FIELD,"RX",RX),"-",""))
  1.  ...D OUTPUT
  1.  ..I FIELD="DUR Response Data" D  S OUTPUT=0 Q
  1.  ...N X S X=@SRC@(DIV,FIELD,"RX",RX)
  1.  ...S VALUE="" D OUTPUT ; "DUR Response Data:"
  1.  ...N FIELD
  1.  ...D DUROUT(X)
  1.  ..I FIELD="Preferred Product" D  S OUTPUT=0 Q  ;OIT/PIERAN/RCS/Patch 42
  1.  ...N X,I S X="" F I=0:1 S X=$O(@SRC@(DIV,FIELD,"RX",RX,X)) Q:X=""  D
  1.  ....S VALUE=@SRC@(DIV,FIELD,"RX",RX,X)
  1.  ....S TITLE="Preferred Product "_X_": "
  1.  ....D OUTPUT
  1.  ..I FIELD="Additional Information" D  S OUTPUT=0 Q  ;OIT/PIERAN/RCS/Patch 42
  1.  ...N X,I S X="" F I=0:1 S X=$O(@SRC@(DIV,FIELD,"RX",RX,X)) Q:X=""  D
  1.  ....S VALUE=@SRC@(DIV,FIELD,"RX",RX,X)
  1.  ....S TITLE="Additional Information "_X_": "
  1.  ....D OUTPUT
  1.  ..S VALUE=@SRC@(DIV,FIELD,"RX",RX),OUTPUT=1
  1.  .I OUTPUT D OUTPUT
  1.  I LEV=0 W " - - Prescription - -",! D FULL(DIV,1)
  1.  Q
  1. OUTPUT ; TITLE,VALUE,!
  1.  W TITLE
  1.  N X S X=VALUE
  1.  N Y S Y=IOM-$X-1 W $E(X,1,Y) S X=$E(X,Y+1,$L(X))
  1.  F  W ! Q:X=""  W $E(X,1,IOM) S X=$E(X,IOM+1,$L(X))
  1.  Q
  1. DUROUT(X)          ; output of DUR string
  1.  N I,L,Y S L=53 F I=0:1:2 D
  1.  .N Y S Y=$E(X,I*L+1,I*L+L)
  1.  .I Y?." " Q  ; blank section
  1.  .I $E(Y,1,2)=" 0" Q  ; PCS test has this
  1.  .I $E(Y,1,2)="  " Q  ; PCS test has this
  1.  .I $E(Y,1,2)="0 " Q  ; PCS test has this (?)
  1.  .I I W "   - - - DUR response data, part ",I+1," - - -",!
  1.  .D DUROUT1(Y)
  1.  Q
  1. DUROUT1(X)         ; output of one substring of DUR string
  1.  N Y
  1.  S TITLE="   Drug Conflict Code: ",VALUE=$$DUR^ABSPECP2($E(X,1,2))
  1.  D OUTPUT
  1.  S TITLE="   Severity Index Code: ",VALUE=$E(X,3) D OUTPUT
  1.  S TITLE="   Other Pharmacy Indicator: "
  1.  S VALUE=$$OTHPHARM^ABSPECP2($E(X,4)) D OUTPUT
  1.  S TITLE="   Previous Date of Fill: ",VALUE=$E(X,5,12)
  1.  I VALUE?8N,VALUE>19900000 S Y=VALUE-17000000 X ^DD("DD") S VALUE=Y
  1.  D OUTPUT
  1.  S TITLE="   Qty. of Previous Fill: ",VALUE=+$E(X,13,17) D OUTPUT
  1.  S TITLE="   Database Indicator: ",VALUE=$E(X,18) D OUTPUT
  1.  S TITLE="   Other Prescriber Indicator: "
  1.  S VALUE=$$OTHPRESC^ABSPECP2($E(X,19)) D OUTPUT
  1.  S TITLE="   Message: ",VALUE=$E(X,20,49) D OUTPUT
  1.  ; bytes 50-53 reserved
  1.  Q
  1. PRINT(SRC,FORMAT) ;
  1.  D PRINTSEG("C0"_FORMAT)
  1.  D PRINTSEG("R0"_FORMAT)
  1.  N RX S RX=0
  1.  F  S RX=$O(@SRC@("C","Prescription Number","RX",RX)) Q:'RX  D
  1.  .D PRINTSEG("C1"_FORMAT)
  1.  .D PRINTSEG("R1"_FORMAT)
  1.  Q
  1. PRINTSEG(SEG) ;
  1.  N DIV S DIV=$E(SEG)
  1.  N LINE,STOP F LINE=0:1 D  Q:$G(STOP)
  1.  .N X S X=$T(@SEG+LINE) I X'[";;" D IMPOSS^ABSPOSUE("P","TI",SEG,,"PRINTSEG",$T(+0)) ; internal error ; missing "*"
  1.  .N FIELD S FIELD=$P(X,";",3)
  1.  .I FIELD="*" S STOP=1 Q
  1.  .F  Q:$E(FIELD)'=" "  S FIELD=$E(FIELD,2,$L(FIELD)) ; leading sp okay
  1.  .Q:FIELD=""  ; empty entry is okay
  1.  .I FIELD="Reject Code" D  Q
  1.  . .N X,I S X="" F I=0:1 S X=$O(@SRC@(DIV,FIELD,"RX",RX,X)) Q:X=""  D
  1.  . . .S VALUE=@SRC@(DIV,FIELD,"RX",RX,X)
  1.  . . .S TITLE=FIELD_":"
  1.  . . .D OUTPUT
  1.  .I FIELD="DUR Response Data" D  Q
  1.  . .S X=$G(@SRC@(DIV,FIELD,"RX",RX))
  1.  . .S TITLE=FIELD_":",VALUE=""
  1.  . .I X="" S TITLE="No "_FIELD D OUTPUT Q
  1.  . .S VALUE="" D OUTPUT ; "DUR Response Data"
  1.  . .N FIELD D DUROUT(X)
  1.  .N VALUE D GETVALUE
  1.  .N TITLE S TITLE=$P(X,";",4)
  1.  .;ZW TITLE R ">>",%,! ZW VALUE R ">>",%,!
  1.  .I TITLE="" S TITLE=FIELD_": "
  1.  .E  X TITLE
  1.  .;ZW TITLE R ">>",%,!
  1.  .I FORMAT'="PCS",VALUE=""!(VALUE?." ") Q
  1.  .D OUTPUT
  1.  Q
  1. GETVALUE ; given SEG,FIELD,RX
  1.  I $E(SEG,2)=0 D  ; a header field
  1.  .S VALUE=$G(@SRC@($E(SEG),FIELD))
  1.  E  I $E(SEG,2)=1 D  ; a prescription field
  1.  .S VALUE=$G(@SRC@($E(SEG),FIELD,"RX",RX))
  1.  E  D IMPOSS^ABSPOSUE("P","TI",SEG,,"GETVALUE",$T(+0)) ; internal error
  1.  Q
  1.  ; Piece 3 - field name
  1.  ; Piece 4 - execute to set TITLE=something based on FIELD and VALUE
  1.  ;Cn is for the claim, Rn is for the response
  1.  ;x0 is for the header, x1 is for the prescription
  1.  ;xxPCS1 is for the receipt for the PCS certification testing
  1.  ;xxANMC1 is for the ANMC receipt
  1. C0ANMC1 ;;Patient Name;S TITLE=""
  1.  ;;Cardholder ID Number
  1.  ;;Electronic Payor
  1.  ;;Claim ID
  1.  ;;*
  1.  ;;
  1. C0PCS1 ;;Patient Name;S TITLE=""
  1.  ;;Group Number
  1.  ;;Cardholder ID Number
  1.  ;;Electronic Payor
  1.  ;;Pharmacy Number
  1.  ;;Claim ID
  1.  ;;Transaction Code
  1.  ;;*
  1. C1ANMC1 ;;Medication Name;S TITLE=""
  1.  ;;Metric Quantity;S TITLE="Quantity: "
  1.  ;;NDC Number
  1.  ;;Date Filled
  1.  ;;Prescription Number
  1.  ;;Transmitted On;S TITLE="Claim sent "
  1.  ;;*
  1. C1PCS1 ;;Medication Name;S TITLE=""
  1.  ;;Date Filled
  1.  ;;Metric Quantity
  1.  ;;Prescription Number
  1.  ;;NDC Number
  1.  ;;DUR Response Data
  1.  ;;Reject Code
  1.  ;;*
  1. R0ANMC1 ;;
  1.  ;;*
  1. R0PCS1 ;;
  1.  ;;*
  1. R1ANMC1 ;;Response Status (Prescription);S TITLE="Prescription Status:"
  1.  ;;Authorization Number
  1.  ;;DUR Response Data
  1.  ;;Reject Code
  1.  ;;Message
  1.  ;;Message (more)
  1.  ;;*
  1. R1PCS1 ;;
  1.  ;;Response Status (Prescription);S TITLE=""
  1.  ;;Authorization Number
  1.  ;;Patient Pay Amount;S TITLE=$J(FIELD,21)
  1.  ;;Ingredient Cost Paid;S TITLE=$J(FIELD,21)
  1.  ;;Contract Fee Paid;S TITLE=$J(FIELD,21)
  1.  ;;Sales Tax Paid;S TITLE=$J(FIELD,21)
  1.  ;;Total Amount Paid;S TITLE=$J(FIELD,21)
  1.  ;;*
  1. C0ALL ;;Claim ID 
  1.  ;;Electronic Payor
  1.  ;;Billing Item IEN
  1.  ;;Transmit Flag
  1.  ;;Transmitted On
  1.  ;;Created On
  1.  ;;Patient Name
  1.  ;;Billing Item PCN #
  1.  ;;Billing Item VCN #
  1.  ;;BIN Number
  1.  ;;Version/Release Number
  1.  ;;Transaction Code
  1.  ;;Processor Control Number
  1.  ;;Pharmacy Number
  1.  ;;Group Number
  1.  ;;Cardholder ID Number
  1.  ;;Person Code
  1.  ;;Date of Birth
  1.  ;;Sex Code
  1.  ;;Relationship Code
  1.  ;;Customer Location
  1.  ;;Other Coverage Code
  1.  ;;Eligibility Clarification Code
  1.  ;;Patient First Name
  1.  ;;Patient Last Name
  1.  ;;*
  1. C1ALL ;;Date Filled
  1.  ;;Prescription Number
  1.  ;;New/Refill Code
  1.  ;;Metric Quantity
  1.  ;;Days Supply
  1.  ;;Compound Code
  1.  ;;NDC Number
  1.  ;;Dispense As Written
  1.  ;;Ingredient Cost
  1.  ;;Sales Tax
  1.  ;;Prescriber ID
  1.  ;;Dispensing Fee Submitted
  1.  ;;Date Prescription Written
  1.  ;;Number Refills Authorized
  1.  ;;PA/MC Code & Number
  1.  ;;Level of Service
  1.  ;;Prescription Origin Code
  1.  ;;Prescription Clarification
  1.  ;;Primary Prescriber
  1.  ;;Clinic ID N
  1.  ;;*
  1. R0ALL ;;
  1.  ;;*
  1. R1ALL ;;
  1.  ;;*