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

ABSPOSM1.m

Go to the documentation of this file. 
  1. ABSPOSM1 ; IHS/FCS/DRS - build Report Master data ;     [ 09/12/2002  10:12 AM ]
  1.  ;;1.0;PHARMACY POINT OF SALE;**3,9,31,32,36,48**;JUN 21, 2001;Build 38
  1.  Q
  1.  ;
  1.  ; File 9002313.61 - ABSP REPORT MASTER
  1.  ;  Purpose: make it easy to use Fileman to get data,
  1.  ;  by storing pointers to various places, indexed by Release Date
  1.  ;
  1.  ;----------------------------------------------------------
  1.  ; IHS/SD/lwj 2/5/04 patch 9  logic added to CLEAN61 to
  1.  ; avoid missing RXI and RXR pointers.  (?? not sure why
  1.  ; they are missing - and they are only missing at Santa Fe.
  1.  ; Without the RX to reference, it's almost impossible to
  1.  ; track down.)
  1.  ;
  1.  ;----------------------------------------------------------
  1.  ;
  1. UPDATE61(BEGINDT,ENDDT,SILENT) ; EP - update the .61 file.
  1.  ; If called with $$, returns 1 success, 0 failure
  1.  I '$D(SILENT) S SILENT=0
  1.  I 'SILENT W !! D LASTRUN
  1.  I '$$LOCK61 D  Q:$Q 0 Q
  1.  . I 'SILENT W !,"Someone else is already using this program.",!
  1.  I '$D(BEGINDT) D  I '$D(BEGINDT) Q:$Q 0 Q
  1.  . N X
  1.  . W !,"Choose the date range of prescription RELEASE DATE",!
  1.  . W "to include in this report.",!
  1.  . S X=$$DTR^ABSPOSU1("Starting at date@time: ","Thru date@time: ",,,"T")
  1.  . Q:'X
  1.  . S BEGINDT=$P(X,U),ENDDT=$P(X,U,2)
  1.  I '$D(ENDDT) S ENDDT=BEGINDT
  1.  I $P(ENDDT,".",2)="" S $P(ENDDT,".",2)=24 ; assume entire day
  1.  I 'SILENT W !,"Thinking..."
  1.  S ^ABSP(9002313.99,1,$T(+0))=BEGINDT_U_ENDDT_U_$$NOW
  1.  D CLEAN61
  1.  D BUILD61
  1.  S $P(^ABSP(9002313.99,1,$T(+0)),U,4)=$$NOW
  1.  D UNLOCK61
  1.  I 'SILENT W !,"Done",!
  1.  Q:$Q 1 Q
  1. AUTO(SILENT) ; EP - entry action to the claims report menu
  1.  ; automatically update for a few days prior to the last update
  1.  ; up through the end of today
  1.  I '$D(SILENT) D  S SILENT=1
  1.  . W !,"...updating the Report Master file, please stand by...",!
  1.  L +^ABSP(9002313.99,1,$T(+0)):+0 Q:'$T  ; could be timing probs; just go on
  1.  N PREV S PREV=$P($G(^ABSP(9002313.99,1,$T(+0))),U,3) ;
  1.  I 'PREV D
  1.  . S PREV=$$TADD^ABSPOSUD($$NOW,-31)\1 ; first time? back 1 month
  1.  . Q:SILENT
  1.  . W !,"Report Master file is being prepared for its first use.",!
  1.  . W "The past month's transactions will be loaded.",!
  1.  . W "If you need to do older reports, use the menu option to ",!
  1.  . W "update the Report Master for a specific date range.",!
  1.  I PREV,PREV\1=DT S PREV=DT ; second time thru today? just do today
  1.  E  S PREV=$$TADD^ABSPOSUD(PREV,-1) ; else reach back 1 day more
  1.  N THRU S THRU=DT+.24
  1.  I 'SILENT D
  1.  . W !,"Updating the Report Master file for "
  1.  . N Y S Y=PREV X ^DD("DD") W Y
  1.  . S Y=THRU X ^DD("DD") W " thru ",Y,!
  1.  ;W "Press ENTER at any time to stop the update.",!
  1.  N ATTIME S ATTIME=$$NOW
  1.  I '$$UPDATE61(PREV,THRU,SILENT) G AUTO9
  1. AUTO9 L -^ABSP(9002313.99,1,$T(+0))
  1.  Q
  1. PREPARE ; not used?
  1.  D WHY
  1. P1 Q:$$UPDYN'=1
  1.  N N S N=$$UPDWHEN I N="" G P1
  1.  W !,"Updating..."
  1.  S N=$$TADD^ABSPOSUD(DT,-N)
  1.  Q:$$UPDATE61(N,DT)
  1.  W !,"Couldn't update the Report Master file",!
  1.  W "You may still try to run some reports, however.",!
  1.  Q
  1. PURPOSE W "The Report Master file is the mechanism which",!
  1.  W "links the Prescription and POS Transaction files together",!
  1.  W "for efficient sorting and Fileman reporting.",!
  1.  Q
  1. WHY ; 
  1.  W "The Report Master file may need to be updated with the latest",!
  1.  W "prescription Released Dates and POS Transaction Numbers",!
  1.  W "to ensure 100% accurate reporting.",!
  1.  Q
  1. UPDYN() N PROMPT S PROMPT="Update the Report Master file now"
  1.  N DEF S DEF="YES"
  1.  N OPT S OPT=1
  1.  N X S X=$$YESNO^ABSPOSU3(PROMPT,DEF,OPT)
  1.  Q $S(X=0:0,X=1:1,1:"")
  1. UPDWHEN() N PROMPT S PROMPT="Update the Report Master file going back how many days? "
  1.  N DEF S DEF=7
  1.  I DEF="" S DEF=1 ; yesterday and today
  1.  N OPT S OPT=1 ; optional response
  1.  N MIN S MIN=0 ; 0 would mean just today
  1.  N MAX S MAX=366
  1.  N X S X=$$NUMERIC^ABSPOSU2(PROMPT,DEF,OPT,MIN,MAX,0)
  1.  I X'?1N.N Q ""
  1.  Q X
  1. LASTRUN N REC S REC=$G(^ABSP(9002313.99,1,$T(+0)))
  1.  I REC="" W "This is the first time the Report Master file has ever been updated.",! Q
  1.  W "The last time the Report Master file was updated was "
  1.  N Y S Y=$P(REC,U,4) S:'Y Y=$P(REC,U,3) X ^DD("DD") W Y,!
  1.  W "The update covered "
  1.  S Y=$P(REC,U) X ^DD("DD") W Y
  1.  S Y=$P(REC,U,2)
  1.  I Y'=$P(REC,U) W " thru " X ^DD("DD") W Y
  1.  W !
  1.  Q
  1. CLEAN61 ;EP - Clean up 9002313.61 for BEGINDT - ENDDT
  1.  ; Delete all entries for which the release date has changed.
  1.  ; Could be that the release date changed on something.
  1.  ;
  1.  ;IHS/SD/lwj 2/5/04 lost pointers for RXR/RXI (patch 9)
  1.  ; adjusted logic of setting WHEN1 to avoid <SBSCR> error
  1.  ; Within loop, E S WHEN1 remarked out, nxt line added
  1.  ;
  1.  N WHEN,WHEN1 S WHEN=BEGINDT
  1.  S WHEN1=0     ;IHS/SD/lwj 2/5/04  patch 9
  1.  F  D  S WHEN=$O(^ABSPECX("RPT","B",WHEN)) Q:'WHEN  Q:WHEN>ENDDT
  1.  . N IEN S IEN=0 F  S IEN=$O(^ABSPECX("RPT","B",WHEN,IEN)) Q:'IEN  D
  1.  . . ;N X S X=^ABSPECX("RPT",IEN,0) ; IHS/OIT/SCR 010510 START avoid undefined error patch 36
  1.  . . N X S X=$G(^ABSPECX("RPT",IEN,0))
  1.  . . I X="" W !,"CORRUPTED X-REF FOUND!",!,"RE-INDEX ABSP REPORT MASTER" Q  ;IHS/OIT/SCR 010510 END avoid undefined error patch 36
  1.  . . S RXI=$P(X,U,4),RXR=$P(X,U,5)
  1.  . . I RXR S WHEN1=$P($G(^PSRX(RXI,1,RXR,0)),U,18)
  1.  . . ;E  S WHEN1=$P($G(^PSRX(RXI,2)),U,13) ;IHS/SD/lwj 2/5/04 ptch 9
  1.  . . E  S:RXI'="" WHEN1=$P($G(^PSRX(RXI,2)),U,13)  ;IHS/SD/lwj 2/5/04
  1.  . . I WHEN'=(WHEN1\1) D DELETE(IEN)
  1.  Q
  1. BUILD61 ; Build file 9002313.61 for BEGINDT - ENDDT
  1.  N IEN S IEN=0
  1.  N WHEN,RXI,RXR S WHEN=BEGINDT
  1.  F  D  S WHEN=$O(^PSRX("AL",WHEN)) Q:'WHEN  Q:WHEN>ENDDT
  1.  . S RXI="" F  S RXI=$O(^PSRX("AL",WHEN,RXI)) Q:RXI=""  D
  1.  . . S RXR="" F  S RXR=$O(^PSRX("AL",WHEN,RXI,RXR)) Q:RXR=""  D
  1.  . . . D ONE
  1.  Q
  1. LOCK61() L +^ABSPECX("RPT"):0 Q $T
  1. UNLOCK61 L -^ABSPECX("RPT") Q
  1. DELETE(IEN) ;
  1.  N FDA,MSG
  1.  S FDA(9002313.61,IEN_",",.01)=""
  1. D5 D FILE^DIE(,"FDA","MSG")
  1.  I $D(MSG) D LOG^ABSPOSL2("D5^ABSPOSM1",.MSG) ; /IHS/OIT/RAM ; 12 JUN 17 ; AND LOG IT IF AN ERROR OCCURS.
  1.  Q:'$D(MSG)  ; success
  1.  D ZWRITE^ABSPOS("FDA","MSG")
  1.  G D5:$$IMPOSS^ABSPOSUE("FM","TRI","FILE^DIE failed",,"DELETE",$T(+0))
  1.  Q
  1. FIND() ; look for existing RXI,RXR entry in 9002313.61
  1.  N IEN,FOUND S (IEN,FOUND)=0
  1.  F  S IEN=$O(^ABSPECX("RPT","C",RXI,IEN)) Q:'IEN  D  Q:FOUND
  1.  . ;N X S X=^ABSPECX("RPT",IEN,0)  ;IHS/OIT/SCR 011510 START avoid undefined error patch 36
  1.  . N X S X=$G(^ABSPECX("RPT",IEN,0))
  1.  . I X="" W !,"CORRUPTED X-REF FOUND!",!,"RE-INDEX ABSP REPORT MASTER" Q  ;IHS/OIT/SCR 011510 END avoid undefined error patch 36
  1.  . I $P(X,U,5)=RXR S FOUND=IEN
  1.  Q FOUND
  1. ONE ; RXI, RXR released at time WHEN
  1.  N FDA,MSG,FN,IENS,IEN57,X
  1.  S IENS=$$FIND
  1.  I '$$FIND S IENS="+1"
  1.  S IENS=IENS_","
  1.  S FN=9002313.61
  1.  S FDA(FN,IENS,.01)=WHEN\1 ; truncate - date only.
  1.  S (IEN57,FDA(FN,IENS,.03))=$$LAST57^ABSPOSBB(RXI,RXR)
  1.  ; added "I IEN57" to next line
  1.  I IEN57 S FDA(FN,IENS,.02)=$P($P($G(^ABSPTL(IEN57,0)),U,8),".") ;ABSP*1.0T7*1
  1.  S FDA(FN,IENS,.04)=RXI
  1.  S FDA(FN,IENS,.05)=RXR
  1.  N RWR,X
  1.  I IEN57 S RWR=$$GET1^DIQ(9002313.57,IEN57_",","RESULT WITH REVERSAL")
  1.  E  S RWR=""
  1.  ;
  1.  ; Note!  Computed fields rely on these code values.
  1.  ; Also, AMOUNT OTHER takes in all the X<0 cases
  1.  ;
  1.  I RWR?1"E ".E D
  1.  . S X=RWR
  1.  . I X="E PAYABLE" S X=4
  1.  . E  I X="E CAPTURED" S X=3
  1.  . E  I X="E DUPLICATE" S X=2
  1.  . E  I X="E REJECTED" S X=1
  1.  . E  I X="E REVERSAL ACCEPTED" S X=11
  1.  . E  I X="E REVERSAL REJECTED" S X=12
  1.  . E  S X=0
  1.  E  I RWR="PAPER" S X=9
  1.  E  I RWR="PAPER REVERSAL" S X=19
  1.  E  S X=15
  1.  S FDA(FN,IENS,.06)=X
  1.  ;
  1.  ; If the claim has any message text, store it
  1.  ; IHS/OIT/SCR 05/04/09 patch 31 : don't store information if it starts and ends with '&'
  1.  ;  e.g. a value of '&ECL;RC:300;&' is a string of multiple Return Codes separated by ';' but
  1.  ;  it looks like garbage on reports and we don't want to see it there. Only Caremark formats
  1.  ;  are using these strings at the moment and no parsing is attempted by this patch
  1.  N MSGTEXT
  1.  I RWR?1"E ".E D
  1.  . S X=$$MESSAGE^ABSPOSM(IEN57,1)
  1.  . ;I ($E(X,1,1)="&")&&($E(X,$L(X),$L(X))="&") Q  ;IHS/OIT/SCR 05/12/09
  1.  . I ($E(X,1,1)="&")&($E(X,$L(X),$L(X))="&") S MSGTEXT(1)="**Screened Msg" Q  ;IHS/OIT/SCR 05/15/09
  1.  . ;I X["SPH:mmc3" Q  ;IHS/OIT/SCR 05/12/09
  1.  . I X["SPH:mmc3" S MSGTEXT(1)="**Screened Msg" Q  ;IHS/OIT/SCR 05/12/09
  1.  . I X]"" S MSGTEXT(1)=X
  1.  . S MSGTEXT(1)=X
  1.  . S X=$$MESSAGE^ABSPOSM(IEN57,2)
  1.  . I ($E(X,1,1)=";") S X=$E(X,2,$L(X)) ;IHS/OIT/SCR patch 32 06/15/09 - remove leading ";"
  1.  . I ($E(X,$L(X),$L(X))=";") S X=$E(X,1,$L(X)-1) ;IHS/OIT/SCR patch 32 06/15/09 - remove trailing ";"
  1.  . I ($E(X,1,1)="&")&($E(X,$L(X),$L(X))="&") S MSGTEXT(2)="**Screened Msg" Q  ;IHS/OIT/SCR 05/15/09
  1.  . I X["SPH:mmc3" S MSGTEXT(2)="**Screened Msg" Q  ;IHS/OIT/SCR 05/15/09
  1.  . I X]"" S MSGTEXT(2)=X
  1.  I $D(MSGTEXT) S FDA(FN,IENS,1300)="MSGTEXT"
  1.  E  S FDA(FN,IENS,1300)=""
  1.  ; 
  1.  ; If it's a rejected claim, build the rejection text
  1.  ;
  1.  N REJTEXT
  1.  I RWR="E REJECTED"!(RWR="E REVERSAL REJECTED") D
  1.  . N RESP,POS D RESPPOS^ABSPOSM(IEN57) ; set RESP,POS pointers
  1.  . D REJTEXT^ABSPOS03(RESP,POS,.REJTEXT)
  1.  . ; word processing text goes into FDA(FILE,IENS,FIELD,n)=text
  1.  . S FDA(FN,IENS,1800)=$S($D(REJTEXT):"REJTEXT",1:"")
  1.  E  S FDA(FN,IENS,1800)=""
  1. ONE5 I IENS["+" D
  1.  . D UPDATE^DIE(,"FDA",,"MSG")
  1.  . I $D(MSG) D LOG^ABSPOSL2("ONE5+2^ABSPOSK1",.MSG) ; /IHS/OIT/RAM ; 12 JUN 17 ; AND LOG IT IF AN ERROR OCCURS.
  1.  E  D
  1.  . D FILE^DIE(,"FDA","MSG")
  1.  . I $D(MSG) D LOG^ABSPOSL2("ONE5+5^ABSPOSK1",.MSG) ; /IHS/OIT/RAM ; 12 JUN 17 ; AND LOG IT IF AN ERROR OCCURS.
  1.  Q:'$D(MSG)  ; success
  1.  D ZWRITE^ABSPOS("IENS","FDA","MSG")
  1.  G ONE5:$$IMPOSS^ABSPOSUE("FM","TRI",$S(IENS["+":"UPDATE",1:"FILE")_"^DIE failed",,"ONE5",$T(+0))
  1.  Q
  1. NOW() N %,%H,%I,X D NOW^%DTC Q %
  1.  Q