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

PSOR52.m

Go to the documentation of this file. 
  1. PSOR52 ;IHS/DSD/JCM - Files refill entries in prescription file ;03/10/93
  1.  ;;7.0;OUTPATIENT PHARMACY;**10,22,27,181,148,201,260,281,358,385,408,532,562,654,699**;DEC 1997;Build 2
  1.  ;Reference to ^PSDRUG supported by DBIA 221
  1.  ;Reference to PSOUL^PSSLOCK supported by DBIA 2789
  1.  ;Reference SWSTAT^IBBAPI supported by DBIA 4663
  1.  ;Reference SAVNDC^PSSNDCUT supported by DBIA 4707
  1.  ; This routine is responsible for the actual
  1.  ; filling of the refill prescription.
  1.  ;---------------------------------------------------------   
  1. EN(PSOX) ;Entry Point
  1. START ;
  1.  D:$D(XRTL) T0^%ZOSV ; Start RT monitor
  1.  D INIT G:PSOR52("QFLG") END
  1.  D FILE
  1.  D DIK
  1.  S:$D(XRT0) XRTN=$T(+0) D:$D(XRT0) T1^%ZOSV ; Stop RT Monitor
  1.  D FINISH
  1. END D EOJ
  1.  Q
  1.  ;---------------------------------------------------------
  1.  ;
  1. INIT ;
  1.  S PSOR52("QFLG")=0
  1.  S PSOX("QTY")=$P(PSOX("RX0"),"^",7),PSOX("DAYS SUPPLY")=$P(PSOX("RX0"),"^",8)
  1.  S PSOX("ADMINCLINIC")=$G(PSORX("ADMINCLINIC"))
  1.  S:$G(^PSDRUG($P(PSOX("RX0"),"^",6),660))]"" PSOX("COST")=$P(^PSDRUG($P(PSOX("RX0"),"^",6),660),"^",6)
  1.  D NOW^%DTC S PSOX("LOGIN DATE")=$E(%,1,7)
  1.  S X1=PSOX("FILL DATE"),X2=PSOX("DAYS SUPPLY")-10\1 D C^%DTC S PSOX1=X
  1.  S X1=$P(PSOX("RX2"),"^",2)
  1.  S X2=PSOX("DAYS SUPPLY")*(PSOX("NUMBER")+1)-10\1
  1.  D C^%DTC S PSOX2=X
  1.  S PSOX("NEXT POSSIBLE REFILL")=$S(PSOX1>PSOX2:PSOX1,1:PSOX2)
  1.  K X,PSOX1,PSOX2
  1.  S (PSOX("LAST DISPENSED DATE"),PSOX("DISPENSED DATE"))=PSOX("FILL DATE")
  1.  I $G(PSOX("MAIL/WINDOW"))="" S PSOX("MAIL/WINDOW")="W"  ;*532
  1.  I PSOX("FILL DATE")>$S($G(PSOX("LOGIN DATE")):$E(PSOX("LOGIN DATE"),1,7),1:DT),$P(PSOPAR,"^",6) D
  1.  .S PSOX("OLD MAIL/WINDOW")=$S($G(PSOX("MAIL/WINDOW"))]"":PSOX("MAIL/WINDOW"),1:"MAIL"),PSOX("MAIL/WINDOW")="M"
  1.  I $P(PSOX("RX2"),"^",12)]"" S PSOX("GENERIC PROVIDER")=$P(PSOX("RX2"),"^",12)
  1.  S PSOX("PROVIDER")=$P(PSOX("RX0"),"^",4)
  1.  S:'$D(PSOX("CLERK CODE")) PSOX("CLERK CODE")=DUZ
  1.  S PSOX("DAW")=$$GETDAW^PSODAWUT(+PSOX("IRXN")),PSOX("NDC")=$$GETNDC^PSSNDCUT($P(PSOX("RX0"),"^",6))
  1. INITX Q
  1.  ;
  1. FILE ;     
  1.  ;L +^PSRX(PSOX("IRXN")):0
  1.  I '$D(^PSRX(PSOX("IRXN"),1,0)) S ^(0)="^52.1DA^1^1"
  1.  E  S ^PSRX(PSOX("IRXN"),1,0)=$P(^PSRX(PSOX("IRXN"),1,0),"^",1,2)_"^"_PSOX("NUMBER")_"^"_($P(^(0),"^",4)+1)
  1.  F PSOX1=1:1 S PSOR52=$P($T(DD+PSOX1),";;",2,4) Q:PSOR52=""  K PSOY S PSOY=$P(PSOR52,";;") I $D(@PSOY) S $P(PSOR52(PSOX("IRXN"),1,PSOX("NUMBER"),$P(PSOR52,";;",2)),"^",$P(PSOR52,";;",3))=@PSOY
  1.  K PSOX1,PSOY
  1.  S PSOX1="" F  S PSOX1=$O(PSOR52(PSOX("IRXN"),1,PSOX("NUMBER"),PSOX1)) Q:PSOX1=""  S ^PSRX(PSOX("IRXN"),1,PSOX("NUMBER"),PSOX1)=$G(PSOR52(PSOX("IRXN"),1,PSOX("NUMBER"),PSOX1))
  1.  K PSOX1
  1.  S:PSOX("STA")=6 $P(^PSRX(PSOX("IRXN"),"STA"),"^")=0
  1.  S $P(^PSRX(PSOX("IRXN"),3),"^",1,2)=PSOX("LAST DISPENSED DATE")_"^"_PSOX("NEXT POSSIBLE REFILL")
  1.  S $P(^PSRX(PSOX("IRXN"),3),"^",4)=PSOX("LAST REFILL DATE")
  1.  I $D(PSOX("METHOD OF PICK-UP")),PSOX("FILL DATE")'>DT S $P(^PSRX(PSOX("IRXN"),"MP"),"^")=PSOX("METHOD OF PICK-UP")
  1.  D:$$SWSTAT^IBBAPI() GACT^PSOPFSU0(PSOX("IRXN"),PSOX("NUMBER"))
  1.  ;L -^PSRX(PSOX("IRXN"))
  1.  Q
  1.  ;
  1. DIK ;
  1.  K DIK,DA
  1.  S DIK="^PSRX(",DA=PSOX("IRXN") D IX1^DIK K DIK
  1.  I +$G(^PSRX(DA,"IB")),$P(^PSRX(DA,1,PSOX("NUMBER"),0),"^",2)="W" S ^PSRX("ACP",$P(^PSRX(DA,0),"^",2),$P(^PSRX(DA,1,PSOX("NUMBER"),0),"^"),PSOX("NUMBER"),DA)="" K DA
  1.  D:$T(EN^PSOHDR)]"" EN^PSOHDR("PREF",PSOX("IRXN"))
  1.  Q
  1.  ;
  1. FINISH ;
  1.  I $G(PSOX("QS"))="S" D  G FINISHX
  1.  . S DA=PSOX("IRXN"),RXFL(PSOX("IRXN"))=PSOX("NUMBER")
  1.  . D SUS^PSORXL K DA
  1.  ;
  1.  ; - Previous ePharmacy Refill was Deleted and a new one is being entered
  1.  I '$$SUBMIT^PSOBPSUT(PSOX("IRXN"),PSOX("NUMBER")),$$STATUS^PSOBPSUT(PSOX("IRXN"),PSOX("NUMBER"))'="" D
  1.  . D RETRXF^PSOREJU2(PSOX("IRXN"),PSOX("NUMBER"),1)
  1.  ;
  1.  I PSOX("FILL DATE")>$S($G(PSOX("LOGIN DATE")):$E(PSOX("LOGIN DATE"),1,7),1:DT),$P(PSOPAR,"^",6) D  G FINISHX
  1.  .K PSOXRXFL I $D(RXFL(PSOX("IRXN"))) S PSOXRXFL=$G(RXFL(PSOX("IRXN")))
  1.  .S DA=PSOX("IRXN"),RXFL(PSOX("IRXN"))=PSOX("NUMBER")
  1.  .D SUS^PSORXL K DA
  1.  .I $G(PSOXRXFL)'="" S RXFL(PSOX("IRXN"))=$G(PSOXRXFL) K PSOXRXFL
  1.  ;
  1.  ; - Calling ECME for claims generation and transmission / REJECT handling
  1.  N ACTION,PSOERX,PSOERF
  1.  S PSOERX=PSOX("IRXN"),PSOERF=PSOX("NUMBER")
  1.  I $$SUBMIT^PSOBPSUT(PSOERX,PSOERF) D  I ACTION="Q"!(ACTION="^") Q
  1.  . S ACTION="" D ECMESND^PSOBPSU1(PSOERX,PSOERF,"","RF")
  1.  . ; Quit if there is an unresolved TRICARE/CHAMPVA non-billable reject code, PSO*7*358
  1.  . I $$PSOET^PSOREJP3(PSOERX,PSOERF) S ACTION="Q" Q
  1.  . I $$FIND^PSOREJUT(PSOERX,PSOERF) D
  1.  . . S ACTION=$$HDLG^PSOREJU1(PSOERX,PSOERF,"79,88,943","OF","IOQ","Q")
  1.  . I $$STATUS^PSOBPSUT(PSOERX,PSOERF)="E PAYABLE" D
  1.  . . D SAVNDC^PSSNDCUT(+$$GET1^DIQ(52,PSOERX,6,"I"),$G(PSOSITE),$$GETNDC^PSONDCUT(PSOERX,PSOERF))
  1.  ;
  1.  I $G(PSOX("QS"))="Q" D  G FINISHX
  1.  . I $G(PPL),$L(PPL_PSOX("IRXN")_",")>240 D TRI^PSOBBC D Q^PSORXL K PPL,RXFL
  1.  . S RXFL(PSOX("IRXN"))=PSOX("NUMBER")
  1.  . I $G(PPL) S PPL=PPL_PSOX("IRXN")_","
  1.  . E  S PPL=PSOX("IRXN")_","
  1.  ;
  1.  N PSODUP       ;P654
  1.  I $G(PSORX("PSOL",1))']"" S PSORX("PSOL",1)=PSOX("IRXN")_",",RXFL(PSOX("IRXN"))=PSOX("NUMBER") G FINISHX
  1.  S PSODUP=0 F PSOX1=0:0 S PSOX1=$O(PSORX("PSOL",PSOX1)) Q:'PSOX1  S PSOX2=PSOX1 I PSORX("PSOL",PSOX1)[PSOX("IRXN") S PSODUP=1 Q
  1.  ;p699 Do not skip setting RXFL if PSODUP is true
  1.  I 'PSODUP D
  1.  . I $L(PSORX("PSOL",PSOX2))+$L(PSOX("IRXN"))<220 S PSORX("PSOL",PSOX2)=PSORX("PSOL",PSOX2)_PSOX("IRXN")_","
  1.  . E  S PSORX("PSOL",PSOX2+1)=PSOX("IRXN")_","
  1.  S RXFL(PSOX("IRXN"))=PSOX("NUMBER")
  1.  ;
  1. FINISHX ; 
  1.  I $G(PSORX("MAIL/WINDOW"))["W" S BINGCRT=1,BINGRTE="W",BBFLG=1 D BBRX^PSORN52C
  1.  K PSOX1,PSOX2
  1.  Q
  1. EOJ ;
  1.  I $D(PSOX("OLD MAIL/WINDOW")) S PSOX("MAIL/WINDOW")=PSOX("OLD MAIL/WINDOW") K PSOX("OLD MAIL/WINDOW")
  1.  S DA=$O(^PS(52.41,"ARF",PSOX("IRXN"),0)) I DA D  S DIK="^PS(52.41," D ^DIK
  1.  .S PSORFKL=DA D PSOUL^PSSLOCK(PSORFKL_"S") K PSORFKL
  1.  K PSOR52,DA,DIK
  1.  Q
  1.  ;
  1. DD ;rx data nodes
  1.  ;;PSOX("PROVIDER");;0;;17
  1.  ;;PSOX("QTY");;0;;4
  1.  ;;PSOX("DAYS SUPPLY");;0;;10
  1.  ;;PSOX("MAIL/WINDOW");;0;;2
  1.  ;;PSOX("REMARKS");;0;;3
  1.  ;;PSOX("CLERK CODE");;0;;7
  1.  ;;PSOX("COST");;0;;11
  1.  ;;PSOSITE;;0;;9
  1.  ;;PSOX("LOGIN DATE");;0;;8
  1.  ;;PSOX("FILL DATE");;0;;1
  1.  ;;PSOX("PHARMACIST");;0;;5
  1.  ;;PSOX("LOT #");;0;;6
  1.  ;;PSOX("DISPENSED DATE");;0;;19
  1.  ;;PSOX("ADMINCLINIC");;0;;20
  1.  ;;PSOX("NDC");;1;;3
  1.  ;;PSOX("DAW");;EPH;;1
  1.  ;;PSOX("MANUFACTURER");;0;;14
  1.  ;;PSOX("EXPIRATION DATE");;0;;15
  1.  ;;PSOX("GENERIC PROVIDER");;1;;1
  1.  ;;PSOX("RELEASED DATE/TIME");;0;;18