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

ABSPOSL.m

Go to the documentation of this file. 
  1. ABSPOSL ; IHS/FCS/DRS - logging ;    
  1.  ;;1.0;PHARMACY POINT OF SALE;;JUN 21, 2001
  1.  Q
  1.  ; Lots of entry points called from lots of places.
  1.  ; 
  1.  ; The job that reads the prescription does this:
  1.  ; DO INIT^ABSPOSL(ABSBRXI,NODELETE) to init a new session
  1.  ;       It will also DO SETSLOT() for you and timestamp.
  1.  ;       NODELETE true will keep anything already there,
  1.  ;       otherwise, any previous data is deleted.
  1.  ; DO LOG^ABSPOSL(text) to log an event
  1.  ; DO RELSLOT^ABSPOSL to release the slot
  1.  ;
  1.  ; The job(s) that build the packet and handle the communications
  1.  ; should do the following to stuff info into a prescription's log:
  1.  ; DO SETSLOT^ABSPOSL(prescription ien)
  1.  ; DO LOG^ABSPOSL(text) to log an event
  1.  ; DO RELSLOT^ABSPOSL to release the slot
  1.  ;
  1.  ; DO LOG2LIST^ABSPOSL(text) to log to all IEN59 in RXILIST(IEN59)
  1.  ; DO LOG2CLM^ABSPOSL(text,IEN02) to log all IEN59 represented
  1.  ;    in ^ABSPC(IEN02, claim
  1.  ; DO LOG59(text,IEN59) to log to IEN59 (does SETSLOT/RELSLOT for you)
  1.  ; DO LOGARRTO(root,slot) to log an entire array to IEN59
  1.  ;
  1.  ; DO FINDPREV(type[,start]) to find most recent slot of given n.type
  1.  ;  (type is the decimal suffix)  start = optional start at this #
  1.  ;
  1.  ; Communications jobs - to not interfere with prescription numbers,
  1.  ; add an extra .1 onto the index.
  1.  ;  DO INIT^ABSPOSL(.1)
  1.  ; Processing responses (ABSPOSQ4) - tacks on .11
  1.  ; Billing jobs - add an extra .2 onto the index - (DT+.2)
  1.  ; Silent submitter (ABSPOSR1) - add .3 - (these will be DT+.3)
  1.  ; Calls to ABSOPSRX - add .4 - (these will be DT+.4)
  1.  ; Winnowing - ABSPOSK - add .5 - (these will be DT+.5)
  1.  ; Back billing - add .6 (these will be DT+.6)
  1.  ;
  1.  ; The job(s) that handle the response should 
  1.  ; DO SETSLOT^ABSPOSL(prescription ien)
  1.  ; DO LOG^ABSPOSL(text) to log an event
  1.  ; DO DONE^ABSPOSL to close a session
  1.  ;       It will also do RELSLOT for you.
  1.  ;
  1.  ;
  1.  ; Other functions:
  1.  ; $$GETSLOT returns the slot # currently in use (as when you wish to
  1.  ;   use a different one and stack this one for later reuse)
  1.  ; $$GETINDEX returns the position of the logging (a subscript,
  1.  ;   a copy of ^ABSPECP("LOG",slot #,0))
  1.  ; $$GETINDEX(SLOT)  gets it for some other given slot, not your own
  1.  ; $$GETPLACE returns $$GETSLOT_","_$$GETINDEX
  1.  ; $$EXISTS(SLOT)   does this slot # exist?
  1.  ;
  1.  ;
  1.  ; PRINTLOG(SLOT) to print the log of entire session from SLOT
  1.  ; PRCLLOG("slot,line",claim#) to print the transmissions log
  1.  ;   excerpt relevant to claim#
  1.  ;
  1.  ; ^ABSPECP("LOG","LAST SLOT")=last # assigned ; obsolete
  1.  ; ^ABSPECP("LOG","JOB",j)=# ; given $J, what's the log #
  1.  ; ^ABSPECP("LOG",#)=time assigned^job number^time done
  1.  ; ^ABSPECP("LOG",#,0)=last n assigned
  1.  ; ^ABSPECP("LOG",#,n)=$H secs^event text
  1.  ;
  1.  ;
  1. LOG(TEXT,ECHO,SPECIAL) ;EP - log the event given by TEXT
  1.  ; SPECIAL="D" to prefix with printable date, T time, DT both
  1.  N H S H=$H
  1.  N SLOT S SLOT=$G(^ABSPECP("LOG","JOB",$J)) Q:'SLOT
  1.  N N S N=$G(^ABSPECP("LOG",SLOT,0))+1,^(0)=N
  1.  I $G(SPECIAL)]"",SPECIAL["D"!(SPECIAL["T") D
  1.  . N %,%H,%I,X,Y D NOW^%DTC S Y=% X ^DD("DD")
  1.  . I SPECIAL'["D" S Y=$P(Y,"@",2)
  1.  . I  I SPECIAL'["T" S Y=$P(Y,"@")
  1.  . S TEXT=Y_" "_TEXT
  1.  S ^ABSPECP("LOG",SLOT,N)=$P(H,",",2)_"^"_$E(TEXT,1,200)
  1.  ;S ECHO=0 ; temporary ; temporary ; temporary ; while testing tasking
  1.  I $G(ECHO) D
  1.  .N IO S IO=$I
  1.  .U $P W:$X>0 ! W TEXT,!
  1.  .U IO
  1.  I $G(SPECIAL)=9999 S $P(^ABSPECP("LOG",SLOT),"^",3)=H
  1.  Q
  1. INIT(SLOTNUM,NODELETE,TMSTAMP) ;EP - very first caller does this:
  1.  ; TMSTAMP undef or 1 -> you'll get a one-line time stamp
  1.  ; TMSTAMP = 0 -> you won't get it.
  1.  ; TMSTAMP = -1 -> timestamp only if brand new log file
  1.  I '$G(^ABSPECP("LOG","LAST SLOT")) D
  1.  . N X S X=$O(^ABSPECP("LOG",999999999999),-1) S:'X X=99
  1.  . S ^ABSPECP("LOG","LAST SLOT")=X\1
  1.  F  L +^ABSPECP("LOG"):300 Q:$T  Q:'$$IMPOSS^ABSPOSUE("L","RTI","interlock on obtaining new log file slot",,"INIT",$T(+0))
  1.  N SLOT
  1.  I $G(SLOTNUM)'<1 D  ; if a specific slot number was specified:
  1.  . S SLOT=SLOTNUM
  1.  E  D  ; SLOTNUM<1, a differential to add
  1.  . I '$D(SLOTNUM) S SLOTNUM=0
  1.  . S SLOT=^ABSPECP("LOG","LAST SLOT")+1+SLOTNUM ; add in the differential
  1.  . ; check:  slot doesn't exist
  1.  . N STOP S STOP=0
  1.  . F  D  Q:STOP  S SLOT=SLOT+1
  1.  . . ; want: nothing in this SLOT\1 range
  1.  . . I $D(^ABSPECP("LOG",SLOT\1)) Q  ; no, ^ABSPECP("LOG",xxx) defined
  1.  . . I $O(^ABSPECP("LOG",SLOT\1))\1=(SLOT\1) Q  ; no,^ABSPECP("LOG",xxx.yy) defined
  1.  . . S STOP=1
  1.  . S ^ABSPECP("LOG","LAST SLOT")=SLOT\1
  1.  D SETSLOT(SLOT)
  1.  I '$G(NODELETE) K ^ABSPECP("LOG",SLOT)
  1.  I '$G(NODELETE)!('$D(^ABSPECP("LOG",SLOT,0))) S ^ABSPECP("LOG",SLOT,0)=0
  1.  I $G(TMSTAMP)=-1 D  ; we want a time stamp only if it's brand new file
  1.  . S TMSTAMP='$D(^ABSPECP("LOG",SLOT,1))
  1.  I $G(TMSTAMP)'=0 D  ; only skip if TMSTAMP is explicitly 0
  1.  . N %,%H,%I,X D NOW^%DTC S Y=% X ^DD("DD") D LOG(Y_" "_%H_" "_%_" "_SLOT)
  1.  L -^ABSPECP("LOG")
  1.  Q
  1. SETSLOT(SLOT) ;EP -
  1.  S ^ABSPECP("LOG","JOB",$J)=SLOT
  1.  ;L +^ABSPECP("LOG",SLOT):0 ZT:'$T
  1.  I SLOT S ^ABSPECP("LOG",SLOT)=$H_"^"_$J
  1.  Q
  1. RELSLOT ; EP  -
  1.  N SLOT S SLOT=$G(^ABSPECP("LOG","JOB",$J))
  1.  I SLOT S $P(^ABSPECP("LOG","JOB",$J),U,2)="R"
  1.  ;L -^ABSPECP("LOG",SLOT)
  1.  Q
  1.  ;
  1. GETSLOT() ;EP -
  1.  N X S X=$G(^ABSPECP("LOG","JOB",$J)) ; = "" if you had none
  1.  I X?.E1"^R" S X="" ; you (or prev user) had one, but it was released
  1.  Q X
  1.  ;
  1. GETINDEX(SLOT)         Q $G(^ABSPECP("LOG",$S($D(SLOT):SLOT,1:$$GETSLOT),0))
  1.  ;
  1. GETPLACE() ;EP -
  1.  Q $$GETSLOT_","_$$GETINDEX
  1.  ;
  1. DONE ;EP -
  1.  D LOG("DONE^ABSPOSL",0,9999)
  1.  D RELSLOT
  1.  K ^ABSPECP("LOG","JOB",$J)
  1.  Q
  1. PRCLLOG(WHERE,CLAIM) ;EP - print portion of comms log related to given claim
  1.  N SLOT,START,END,END1,X,FOUND
  1.  S SLOT=$P(WHERE,","),START=$P(WHERE,",",2)
  1.  S END=$$PRINTEND(SLOT) I 'END Q
  1.  ; Is the START what we expect?
  1.  ; this must match text at CLAIMBEG, CLAIMEND^ABSPOSAM
  1.  S X=$G(^ABSPECP("LOG",SLOT,START))
  1.  I $P(X,U,2)'[("CLAIM - BEGIN - #"_CLAIM) D  Q
  1.  .W "Found ",X,!
  1.  .W "  instead of expected beginning of claim ",CLAIM,".",!
  1.  S FOUND=0 ; whether we found the expected end or not
  1.  F END1=START+1:1:END D  Q:FOUND  ; with END1 pointing to the end
  1.  .S X=$G(^ABSPECP("LOG",SLOT,END1))
  1.  .I $P(X,U,2)[("CLAIM - END - #"_CLAIM) S FOUND=1
  1.  I 'FOUND D
  1.  .W "Did not find the expected end of claim transmission info.",!
  1.  .W "We will print out some of what is there.",!
  1.  .S END1=START+25 S:END1>END END1=END
  1.  D PRINTLOG(SLOT,START,END1)
  1.  Q
  1. PRINTEND(SLOT) ;EP -find the end of the logging session 
  1.  N END S END=$G(^ABSPECP("LOG",SLOT,0))
  1.  I 'END D
  1.  .W "Missing the 0 node that tells us where the end is?",!
  1.  .S END=$O(^ABSPECP("LOG",SLOT,""),-1)
  1.  .W "Working backwards, we think the end is at ",END,!
  1.  Q END
  1. PRINTLOG(SLOT,START,END)     ;EP -
  1.  D PRINTLOG^ABSPOSL1(SLOT,$G(START),$G(END)) Q
  1. HDIF(THEN,NOW)     Q $P(NOW,",")-$P(THEN,",")*86400+$P(NOW,",",2)-$P(THEN,",",2)
  1. EXISTS(X) ;EP -
  1.  Q $D(^ABSPECP("LOG",X))
  1. FINDPREV(TYPE,START) ;
  1.  I '$D(START) D  Q:'START
  1.  . I TYPE>1 S START=TYPE-1,TYPE=TYPE#1 Q
  1.  . S START=+$G(^ABSPECP("LOG","LAST SLOT"))+1
  1.  I START#1=0 S START=START+TYPE
  1.  I START#1'=TYPE S START=START\1-1+TYPE
  1.  F  Q:$D(^ABSPECP("LOG",START))  S START=START-1 I START<1 S START="" Q
  1.  Q START
  1.  ; These logging utilities originally came from ABSPOSQ2
  1. LOG2LIST(MSG) ;EP - write MSG to the log files of all in RXILIST(*)
  1.  N IEN59 S IEN59=0
  1.  F  S IEN59=$O(RXILIST(IEN59)) Q:'IEN59  D
  1.  . D LOG59(MSG,IEN59)
  1.  Q
  1. LOG2CLM(MSG,IEN02) ;EP - write MSG to log file for all claims in this 9002313.02
  1.  N IEN59 S IEN59=0
  1.  F  S IEN59=$O(^ABSPT("AE",IEN02,IEN59)) Q:'IEN59  D
  1.  . D LOG59(MSG,IEN59)
  1.  Q
  1. LOG59(MSG,IEN59)   ;EP -
  1.  D LOG2SLOT(MSG,IEN59) Q
  1.  ; obsolete:
  1.  D SETSLOT(IEN59)
  1.  D LOG(MSG)
  1.  D RELSLOT
  1.  Q
  1. LOG2SLOT(MSG,SLOT) ;EP -
  1.  N OLDSLOT S OLDSLOT=$$GETSLOT
  1.  D SETSLOT(SLOT)
  1.  D LOG(MSG)
  1.  D RELSLOT
  1.  D SETSLOT(OLDSLOT)
  1.  Q
  1. LOGARRAY(ROOT,SLOT,MAX) ;EP -
  1.  N REF S REF=ROOT
  1.  N COUNT S COUNT=0
  1.  I '$D(MAX) S MAX=100
  1.  I $D(@REF)#10'=1 S REF=$Q(@REF)
  1.  F  Q:REF=""  D  Q:'MAX
  1.  . I $D(SLOT) D
  1.  . . D LOG2SLOT(REF_"="_@REF,SLOT)
  1.  . E  D LOG(REF_"="_@REF)
  1.  . S COUNT=COUNT+1
  1.  . S REF=$Q(@REF)
  1.  . S MAX=MAX-1
  1.  I 'MAX,REF]"" D LOG2SLOT("More of "_ROOT_" to log, but max reached",SLOT)
  1.  I 'COUNT D LOG2SLOT("Nothing found in "_ORIGROOT,SLOT)
  1.  Q