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

ABSPOSS.m

Go to the documentation of this file.
  1. ABSPOSS ; IHS/FCS/DRS - POS setup ;
  1. ;;1.0;PHARMACY POINT OF SALE;;JUN 21, 2001
  1. Q
  1. INSUR ;EP - option ABSP INSURANCE EDIT ; Edit insurance info
  1. D INSURSYS()
  1. W !!?5,"SELECT an INSURER - the insurer must already be in the"
  1. W !?8,"RPMS INSURER file, but you may need to answer Yes if it"
  1. W !?8,"asks about adding the insurer to the FSI INSURER file."
  1. W !
  1. N DIC,DLAYGO,DIE,DA,DR,IEN,X,Y,I
  1. LOOP ;
  1. S DIC="^ABSPEI(",DIC(0)="QEALM",DLAYGO=9002313.4
  1. S DIC("A")="Edit PHARMACY settings for which INSURER: "
  1. D ^DIC
  1. S IEN=+Y Q:IEN<0
  1. W !!?5,"RX BILLING STATUS:"
  1. W !?8,"If this insurance does not cover pharmacy, answer with U."
  1. W !?8,"To remove an UNBILLABLE status, answer with @."
  1. W !?8,"Don't use the answer O unless you're really sure about it."
  1. W !
  1. S DIE="^AUTNINS(",DA=IEN,DR=.23 D ^DIE
  1. ;
  1. W !!?5,"GRACE PERIOD: usually left blank in here."
  1. S DIE="^ABSPEI(",DA=IEN,DR=100.08 D ^DIE
  1. W !
  1. W !!?5,"PRINT ON WHICH FORMS? Select NCPDP, UB92, or 1500",!
  1. S DIE="^ABSPEI(",DA=IEN,DR="105:105.99" D ^DIE
  1. W !
  1. W !?5,"NCPDP Forms detail: answer with ? for help on any question."
  1. S DIE="^ABSPEI(",DA=IEN,DR="100.09:100.13" D ^DIE
  1. W !!!
  1. G LOOP
  1. Q
  1. INSURSYS(X) ; display the system-wide defaults for insurance
  1. I '$D(X) S X=99
  1. I X>0 D
  1. . W !,"The system-wide defaults for POS and insurance are currently:",!
  1. D INSURNCP ; NCPDP form settings
  1. D INSURPRE ; prebill settings
  1. D INSURINS ; other settings
  1. I X>0 D
  1. . W !
  1. . W "These settings apply to all insurances, unless you make special",!
  1. . W "settings for a particular insurer in this program.",!
  1. Q
  1. INSURNCP D DIQ99("FORMS - NCPDP") Q
  1. INSURPRE D DIQ99("FORMS - PREBILL") Q
  1. INSURINS D DIQ99("INS") Q
  1. DIQ99(DR) S DIC="^ABSP(9002313.99,",DA=1 D EN^DIQ Q