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