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

ABSPOSK.m

Go to the documentation of this file. 
  1. ABSPOSK ; IHS/FCS/DRS - winnow POS data ;   
  1.  ;;1.0;PHARMACY POINT OF SALE;;JUN 21, 2001
  1.  Q
  1. SILENT(LOGSONLY) ;EP - do it silently, as in taskmanned task
  1.  ; $G(LOGSONLY)=1 if you are winnowing log files only.
  1.  ; Invoked sporadically at random from transaction completion in ABSPOSU
  1.  N SILENT S SILENT=1
  1. MAIN ;EP - show progress
  1.  L +^TMP($T(+0)):0 Q:'$T  ; only one winnower at a time
  1.  ; (this protects against the case where two or more of these happen
  1.  ;  to be scheduled at random throughout the day)
  1.  D  ; log files
  1.  . N X S X=$G(^ABSP(9002313.99,1,"WINNOW LOGS"))
  1.  . D INIT^ABSPOSL(DT+.5,1)
  1.  . S X=DT+.5_U_$P(X,U,1,9) ; shift old down one spot and put new in
  1.  . S ^ABSP(9002313.99,1,"WINNOW LOGS")=X
  1.  ; NEW the vars commonly used
  1.  N IEN,AGE,BILLSYS,TESTING,ISILCAR,NENTRIES,OLDPCT,COUNT
  1.  S ISILCAR=$$ISILCAR^ABSPOSB ; some algorithms vary if you have ILC A/R
  1.  D AGES ; set AGE(field name)=value
  1.  D BILLSYS ; set BILLSYS=which billing system interface (internal)
  1.  S TESTING=$P($G(^ABSP(9002313.99,1,"WINNOW TESTING")),U)
  1.  I TESTING D LOG("Just testing; nothing will actually be deleted.")
  1.  E  D LOG("This is for real; we may really delete some data.")
  1.  ; The order of these files is important!  Certain things won't be
  1.  ; deleted if the things pointed to them are still around.
  1.  I $G(LOGSONLY) G LOGS
  1.  D LOGHDG(9002313.57),INIFOR(9002313.57)
  1.  D 57 ; 9002313.57 Billing
  1.  D LOGHDG(9002313.59),INIFOR(9002313.59)
  1.  D 59 ; 9002313.59 Working
  1.  D LOGHDG(9002313.03),INIFOR(9002313.03)
  1.  D 03 ; 9002313.03 Responses
  1.  D LOGHDG(9002313.02),INIFOR(9002313.02)
  1.  D 02 ; 9002313.02 Claims
  1.  D LOGHDG(9002313.51),INIFOR(9002313.51)
  1.  D 51 ; 9002313.51 Input
  1.  D LOGHDG(9002313.511),INIFOR(9002313.511)
  1.  D 511 ; 9002313.511 Override
  1.  D LOGHDG("COMBINS"),INIFOR(9002313.1)
  1.  D COMBINS ; combined insurance
  1. LOGS D LOGHDG("LOG FILES"),INIFOR("LOG FILES")
  1.  D LOGFILES ; Log files in ^ABSPECP("LOG",
  1.  D RELSLOT^ABSPOSL
  1.  L -^TMP($T(+0))
  1.  Q
  1. INIFOR(F)          ;
  1.  S COUNT=0,OLDPCT=""
  1.  I +F=F D
  1.  . I F=9002313.02 S NENTRIES=$P(^ABSPC(0),U,4)
  1.  . E  I F=9002313.03 S NENTRIES=$P(^ABSPR(0),U,4)
  1.  . E  I F=9002313.1 S NENTRIES=$P(^ABSPCOMB(0),U,4)
  1.  . E  S NENTRIES=$P(^ABSP(F,0),U,4)
  1.  E  D
  1.  . ; note: percentages will be off for the log files
  1.  . I F="LOG FILES" S NENTRIES=$P(^ABSPECP("LOG","LAST SLOT"),U)
  1.  Q
  1. LOGHDG(FILE)       ;
  1.  N X ;
  1.  D LOGLINES
  1.  I FILE="COMBINS" S FILE=9002313.1 ; renumbered since original rou
  1.  I +FILE=FILE D
  1.  . S X="Winnowing file "_FILE_": "_$P(^DIC(FILE,0),U)
  1.  E  D
  1.  . I FILE="LOG FILES" S X="Winnowing "_FILE
  1.  D LOG(X)
  1.  D LOGLINES
  1.  Q
  1.  ; Instead of going by indexes, just scan the entire file.
  1.  ; There may be some without the date field set, for example.
  1.  ; We don't want those hanging around forever.
  1.  ;
  1. 03 ; 9002313.03 Responses
  1.  S IEN=0 F  S IEN=$O(^ABSPR(IEN)) Q:'IEN  D 03^ABSPOSK1,PCT
  1.  D LOGDONE
  1.  Q
  1. 02 ; 9002313.02 Claims
  1.  S IEN=0 F  S IEN=$O(^ABSPC(IEN)) Q:'IEN  D 02^ABSPOSK1,PCT
  1.  D LOGDONE
  1.  Q
  1. 51 ; 9002313.51 Input
  1.  S IEN=0 F  S IEN=$O(^ABSP(9002313.51,IEN)) Q:'IEN  D 51^ABSPOSK1,PCT
  1.  D LOGDONE
  1.  Q
  1. 511 ; 9002313.511 Override
  1.  S IEN=0
  1.  F  S IEN=$O(^ABSP(9002313.511,IEN)) Q:'IEN  D 511^ABSPOSK1,PCT
  1.  D LOGDONE
  1.  Q
  1. 57 ; 9002313.57 Billing
  1.  S IEN=0 F  S IEN=$O(^ABSPTL(IEN)) Q:'IEN  D 57^ABSPOSK1,PCT
  1.  D LOG("Fixing 9002313.57 indexes...") D FIX57IDX^ABSPOSK2
  1.  D LOGDONE
  1.  Q
  1. 59 ; 9002313.59 Working
  1.  S IEN=0 F  S IEN=$O(^ABSPT(IEN)) Q:'IEN  D 59^ABSPOSK1,PCT
  1.  D LOGDONE
  1.  Q
  1. LOGFILES ; ^ABSPECP("LOG",
  1.  S IEN=0
  1.  F  S IEN=$O(^ABSPECP("LOG",IEN)) Q:'IEN  D LOGFILES^ABSPOSK1,PCT
  1.  D LOGDONE
  1.  Q
  1. COMBINS ; ^ABSPCOMB(
  1.  ; Our POS combined insurance can be winnowed because
  1.  ; we don't keep any pointers to combined insurance.
  1.  ; This is different in A/R, I think.
  1.  S IEN=0
  1.  F  S IEN=$O(^ABSPCOMB(IEN)) Q:'IEN  D COMBINS^ABSPOSK1,PCT
  1.  D LOGDONE
  1.  Q
  1. PCT Q:'NENTRIES  Q:$G(SILENT)  S COUNT=COUNT+1
  1.  N X S X=COUNT/NENTRIES*100+.5\1 S:X=101 X=100
  1.  I X'=OLDPCT W @IOBS,@IOBS,@IOBS,@IOBS,@IOBS,$J(X,3),"% " S OLDPCT=X
  1.  Q
  1. LOGDONE D LOG("Done with this part.") Q
  1. LOG(X) D LOG^ABSPOSL(X)
  1.  I '$G(SILENT) U $P W X,!
  1.  Q
  1. LOGLINES N X S X=$J("",60),X=$TR(X," ","=") D LOG(X) Q
  1. GET99(FIELD)       ; ^ABSP(9002313.99,1,"WINNOWING")
  1.  ; field numbers #2341.nn
  1. AGES ; set AGE(field name) = value for field numbers 2341.nn
  1.  I $G(^ABSP(9002313.99,1,"WINNOW"))?."^" D
  1.  . ; Set some defaults if nothing has been explicitly set.
  1.  . N X S X="400^100^100^100^31^366^31^366^100^100^366^0"
  1.  . S ^ABSP(9002313.99,1,"WINNOW")=X
  1.  N FIELD S FIELD=2341
  1.  F  S FIELD=$O(^DD(9002313.99,FIELD)) Q:FIELD'<2342  Q:'FIELD  D
  1.  . N NAME,DEST D FIELD^DID(9002313.99,FIELD,,"LABEL","DEST")
  1.  . S NAME=$G(DEST("LABEL"))
  1.  . I NAME="" D
  1.  . . D ZWRITE^ABSPOS("FIELD","DEST")
  1.  . . D IMPOSS^ABSPOSUE("FM","TI","FIELD^DID(9002313.99 failed on field "_FIELD,,"AGES",$T(+0))
  1.  . N VALUE S VALUE=$$GET1^DIQ(9002313.99,"1,",FIELD)
  1.  . I VALUE="" S VALUE=365+365+366 ; 3 years
  1.  . S AGE(NAME)=VALUE
  1.  . D LOG("AGE("_NAME_")="_VALUE)
  1.  Q
  1. BILLSYS ; set BILLSYS= which billing system you're interfacing to
  1.  S BILLSYS=$$GET1^DIQ(9002313.99,"1,",170.01)
  1.  D LOG("BILLSYS="_BILLSYS)
  1.  Q