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

ABSPOSN1.m

Go to the documentation of this file. 
  1. ABSPOSN1 ; IHS/FCS/DRS - NCPDP forms for ILC A/R ;    [ 09/12/2002  10:15 AM ]
  1.  ;;1.0;PHARMACY POINT OF SALE;**3**;JUN 21, 2001;Build 38
  1.  ; *****
  1.  ; *****  Interface to ABSB, the ILC A/R package
  1.  ; *****  This code is reached _ONLY_ by sites using ILC A/R,
  1.  ; *****  and who choose to interface to it.
  1.  ; *****
  1.  ; Note: references to ^ABSBCOMB are legitimately supposed to be such;
  1.  ; they are testing for ILC A/R Version 2 - they were definitely left
  1.  ; as such and purposefully not changed to ^ABSPCOMB
  1.  Q
  1.  ;
  1. EN1 ;Entry point to NCPDP PHARMACY PRE BILLING REPORT option
  1.  N EXIT
  1.  S EXIT=0
  1.  D HEADER^ABSPOSN7("NCPDP Pharmacy - Pre Billing List")
  1.  D DEVICE^ABSPOSN7("Print report on which DEVICE? ",.EXIT)
  1.  I EXIT W @IOF Q
  1.  D EN^ABSPOSN5("NCPDP PHARMACY PRE BILLING REPORT","APRX1")
  1.  D ^%ZISC
  1.  W @IOF
  1.  Q
  1.  ;----------------------------------------------------------------------
  1.  ; Obsolete option ; but it will be in the new NCPDP forms.
  1.  ;EN2      ;Entry point to NCPDP PHARMACY FORM ALIGNMENT option
  1.  ;----------------------------------------------------------------------
  1. EN3 ;Entry point to PRINT NCPDP PHARMACY FORMS option
  1.  I '$D(^ABSBITMS) D  Q  ; cannot reach this until you have ILC A/R
  1.  . D IMPOSS^ABSPOSUE("P","TI","This option is ONLY for ILC A/R.",,"EN3",$T(+0)) ; and it should be unreachable, too - so what are you doing here?
  1.  I $D(^ABSBCOMB) D  Q  ; I running the ILC A/R V2 package, then
  1.  . D EN^ABSB1592("NCPDP") Q  ; call the generalized routine
  1.  ; to print the forms. 
  1.  ;  It provides a consistent interface across all forms printing!
  1.  ;  Same, whether you're doing UB92 or NCPDP or whatever.
  1.  ; But the old a/r package still uses this code:
  1.  N EXIT,DA,OK
  1.  K ^BLLAUDIT($J,"APRX")
  1.  S EXIT=0
  1.  D HEADER^ABSPOSN7("NCPDP Pharmacy - Print Forms")
  1.  D DEVICE^ABSPOSN7("Print NCPDP PHARMACY FORMS on which DEVICE? ",.EXIT)
  1.  I EXIT W @IOF Q
  1.  ;
  1.  I IO'=$P U $P W !,"Printing Forms..."
  1.  U IO
  1.  S DA=""
  1.  F  D  Q:'+DA!(EXIT)
  1.  .S DA=$O(^ABSBITMS(9002302,"APRX",1,DA))
  1.  .Q:'+DA
  1.  .D PBITEM^ABSPOSN2(DA)
  1.  .S ^BLLAUDIT($J,"APRX",DT,DA)=""
  1.  .D:IO=$P CONTINUE^ABSPOSN7(.EXIT)
  1.  .I IO'=$P U $P W "."
  1.  .U IO
  1.  D ^%ZISC
  1.  U $P
  1.  I EXIT W @IOF Q
  1.  ;
  1.  W !!
  1.  S OK=$$YESNO^ABSPOSU3("Did NCPDP Pharmacy Forms print correctly? ",,0,9999)
  1.  ;
  1.  I '(OK=1) D  Q
  1.  .K ^BLLAUDIT($J,"APRX")
  1.  W !!
  1.  S OK=$$YESNO^ABSPOSU3("Okay to UPDATE the bills? ",,0,99999)
  1.  I '(OK=1) D  Q
  1.  .W *7,!!,"No updating of bills has occurred!" H 2
  1.  .K ^BLLAUDIT($J,"APRX")
  1.  ;
  1.  W !!,"Updating printed bills..."
  1.  S DA=""
  1.  F  D  Q:'+DA
  1.  .S DA=$O(^BLLAUDIT($J,"APRX",DT,DA))
  1.  .Q:'+DA
  1.  .W "."
  1.  .D UPDATE(DA)
  1.  K ^BLLAUDIT($J,"APRX")
  1.  W @IOF
  1.  Q
  1.  ;----------------------------------------------------------------------
  1. EN4 ;Entry point to REPRINT ONE NCPDP PHARMACY FM option
  1.  N EXIT,DIC,Y,DA,PCNLIST
  1.  S EXIT=0
  1.  D HEADER^ABSPOSN7("NCPDP Pharmacy - Reprint One Form")
  1.  ;
  1. EN4B ; loop back here to ask F another one
  1.  S DIC="^ABSBITMS(9002302,",DIC(0)="AEMNQ"
  1.  ;S DIC("S")="I $P($G(^(9)),U,2)[""RX"""
  1.  ; This screen relies on certain conventions about A/R types naming
  1.  ; We may have to remove it or generalize it someday.
  1.  ; F now, let the quick and dirty thing here run its course
  1.  S DIC("S")="N % S %=$P($G(^(9)),U,2) I %[""RX""!(%[""PH"")"
  1.  D ^DIC
  1.  S DA=+Y
  1.  I $D(DUOUT) W @IOF Q
  1.  I '$D(^ABSBCOMB) G EN4A ; old a/r package - just the one; go Do it
  1.  I DA<0 D  Q  ; okay, got the list
  1.  . I '$D(PCNLIST) Q  ; didn't select any
  1.  . ;I DUZ=120,DUZ(2)=1859 W !,"You're going to print ",! ZW PCNLIST W !
  1.  . D EN^ABSB1592("NCPDP",.PCNLIST) ; call the omniprint routine
  1.  W !,"Okay.  Select another one, or hit enter.",!
  1.  S PCNLIST(DA)="" G EN4B
  1.  ;
  1. EN4A ;
  1.  W !!
  1.  D DEVICE^ABSPOSN7("Print NCPDP PHARMACY FORM on which DEVICE? ",.EXIT)
  1.  I EXIT W @IOF Q
  1.  ;S DTIME=99999999
  1.  I IO'=$P U $P W !,"Printing Forms..."
  1.  D PBITEM^ABSPOSN2(DA)
  1.  D ^%ZISC
  1.  ;S DTIME=600
  1.  ;
  1.  W @IOF
  1.  Q
  1.  ;------------------------------------------------------------------
  1.  ;UPDATE the PRINT PCS PHARMACY flag and DATE BILLED Multiple
  1. UPDATE(PCNDFN) ;
  1.  N COMPANY,BILLDFN,SELFPAY,VL,BILLTOT
  1.  S COMPANY=$S($P(^ABSBITMS(9002302,PCNDFN,0),U,3)="":"SELF PAY",1:$P(^ABSBITMS(9002302,PCNDFN,0),U,3))
  1.  I $D(^ABSBITMS(9002302,PCNDFN,2,0)) S BILLDFN=$P(^ABSBITMS(9002302,PCNDFN,2,0),"^",3)+1,^ABSBITMS(9002302,PCNDFN,2,0)="^9002302.04DA^"_BILLDFN_"^"_BILLDFN
  1.  E  S ^ABSBITMS(9002302,PCNDFN,2,0)="^9002302.04DA^1^1",BILLDFN=1
  1.  S SELFPAY=0
  1.  I BILLDFN=1 F VL=0:0 S VL=$O(^ABSBITMS(9002302,PCNDFN,7,VL)) Q:'VL  I $P(^(VL,0),U,4)["SELF-PAY" S SELFPAY=SELFPAY+$P(^(0),U,2)
  1.  S BILLTOT=SELFPAY+$P(^ABSBITMS(9002302,PCNDFN,3),U,1)
  1.  S ^ABSBITMS(9002302,PCNDFN,2,BILLDFN,0)=DT_"^NONE^"_BILLTOT_"^"_COMPANY
  1.  S $P(^ABSBITMS(9002302,PCNDFN,"PB"),U,6)=0
  1.  K ^ABSBITMS(9002302,"APRX",1,PCNDFN)
  1.  S ^ABSBITMS(9002302,"APRX",0,PCNDFN)=""
  1.  Q