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

ABSPOSUA.m

Go to the documentation of this file. 
  1. ABSPOSUA ; IHS/FCS/DRS - sort and print utilities ;    
  1.  ;;1.0;PHARMACY POINT OF SALE;**37**;JUN 21, 2001;Build 38
  1.  Q
  1. DEFDEST()          Q "^TMP("""_$T(+0)_""","_$J_",1)" ; default dest for sort
  1. SAVEAREA()         Q "^TMP("""_$T(+0)_""","_$J_",2)" ; if you save old vers.
  1. SAVEOLD K @$$SAVEAREA M @$$SAVEAREA=@$$DEFDEST Q
  1.  ;
  1. SORT(USER,PATDFN,TDIF,INIT,DEST,LOCK) ;EP - from ABSPOS6I
  1.  ; USER = DUZ or 0 for all users
  1.  ; USER = DUZ # you want;  MINS = within the last N minutes
  1.  ;  (Because of timing, you might catch a prescription more than once)
  1.  ; PATDFN = a particular patient or 0 for all patients
  1.  ; TDIF = days.hhmmss = 0.0015, for instance, for last 15 minutes
  1.  ; or TSINCE, e.g. 2991105.140305, for changes since absolute time
  1.  ; If TDIF is given, TSINCE is computed from NOW^%DTC and TDIF 
  1.  ; TDIF can be positive and we'll take care of treating it as minus.
  1.  ; TDIF can theoretically be   days.hhmmss  but in practice it's
  1.  ;  either one or the other.
  1.  ; INIT = 1 if you want to init list (erase what's there now)
  1.  ; DEST defaults to ^TMP("ABSPOSUA",$J)
  1.  ;      If it's a global,it must begin with ^TMP( or ^UTILITY(
  1.  ; LOCK defaults to 1, Lock file 9002313.59
  1.  ;   It seems that not locking really does lead to some misleading
  1.  ;   displays.
  1.  ; - - - - - It builds this: - - - - -
  1.  ; @DEST=how many patients
  1.  ; @DEST@(patname)=how many prescriptions for this patient
  1.  ; @DEST@(patname,"RXI",ABSBRXI)=status^datetime last update
  1.  ; And this node, which we aren't using anymore:
  1.  ; @DEST@(patname,100-status,9'sDate9'sTime,ABSBRXI)="" for each presc
  1.  ;
  1.  ; Returns the root reference of the DEST.
  1.  ;
  1. SORT0 N ROU S ROU=$T(+0)
  1.  I '$D(USER) S USER=0
  1.  I '$D(PATDFN) S PATDFN=0
  1.  I '$D(TDIF) S TDIF=0.001500
  1.  I '$D(INIT) S INIT=1
  1.  I '$D(DEST) S DEST=$$DEFDEST
  1.  I $E(DEST)="^",$P(DEST,"(")'="^TMP",$P(DEST,"(")'="^UTILITY" D  Q
  1.  . D IMPOSS^ABSPOSUE("P","TI","we cannot use "_DEST_" for scratch storage",,,$T(+0))
  1.  I '$D(LOCK) S LOCK=1
  1. SORT1 N NOW,%,%H,%I,X D NOW^%DTC S NOW=%
  1.  N TIME,STARTTIM ;S (TIME,STARTTIM)=$$TADD(NOW,TDIF)
  1.  N ROOT S ROOT="^ABSPT"
  1.  I TDIF>2990000 S (TIME,STARTTIM)=TDIF ; absolute time was given
  1.  E  S (TIME,STARTTIM)=$$TADD(NOW,TDIF*$S(TDIF>0:-1,1:1)) ; delta
  1.  I INIT K @DEST S @DEST=0
  1.  I $G(LOCK) L +@ROOT:3600
  1.  D SORT2
  1.  I $G(LOCK) L -@ROOT
  1.  Q:$Q DEST Q
  1.  ;
  1. SORT2 ; If doing one particular patient, then use the patient index
  1.  I PATDFN D
  1.  . S STARTTIM=STARTTIM\1
  1.  . S RXI="" F  S RXI=$O(@ROOT@("AC",PATDFN,RXI)) Q:'RXI  D
  1.  . . Q:$P($G(@ROOT@(RXI,0)),U,8)<STARTTIM
  1.  . . D SORT3
  1.  E  D  ; If doing the usual time search, use the time index
  1.  . F  D  S TIME=$O(@ROOT@("AH",TIME)) Q:'TIME
  1.  . . S RXI="" F  S RXI=$O(@ROOT@("AH",TIME,RXI)) Q:'RXI  D SORT3
  1.  Q
  1. SORT3 ;
  1.  N X S X=$G(@ROOT@(RXI,0)) Q:X=""
  1.  I USER,$P(X,U,10)'=USER Q
  1.  I PATDFN,$P(X,U,6)'=PATDFN Q
  1.  ;IHS/OIT/SCR 021110 patch 37 START don't add this RX if it is closed
  1.  N ABSPCLSD
  1.  S ABSPCLSD=$P($G(@ROOT@(RXI,9)),U,1)
  1.  Q:ABSPCLSD
  1.  ;IHS/OIT/SCR 021110 patch 37 END don't add this RX if it is closed
  1.  ; Compute time diff with record - in case index is corrupted
  1.  ; Criteria met - so include this record
  1.  N STATUS S STATUS=$P(X,U,2)
  1.  N STAT99 S STAT99=100-STATUS
  1.  N TIME99 S TIME99=9999999.99999999-$P(X,U,8)
  1.  I 'PATDFN N PATDFN S PATDFN=$P(X,U,6)
  1.  N PATNAME I PATDFN S PATNAME=$P($G(^DPT(PATDFN,0)),U)
  1.  S:$G(PATNAME)="" PATNAME="Patient `"_PATDFN
  1.  I '$D(@DEST@(PATNAME)) S @DEST=@DEST+1,@DEST@(PATNAME)=0
  1.  E  I $D(@DEST@(PATNAME,"RXI",RXI)) Q  ; timing - we got this twice
  1.  ;W "TIME=",TIME,",RXI=",RXI,",",$ZR,"=",@$ZR," now increment..."
  1.  S @DEST@(PATNAME)=@DEST@(PATNAME)+1
  1.  ;W "=",@$ZR,! H 1
  1.  S @DEST@(PATNAME,STAT99,TIME99,RXI)=""
  1.  S @DEST@(PATNAME,"RXI",RXI)=$S(STATUS=99:100,1:STATUS)_U_TIME
  1.  Q
  1. DISP(USER) ; display @ROOT@(pat,status99,time99,rxi)
  1.  N ROU S ROU=$T(+0) N X,Y,I,RXI
  1.  I '$G(^TMP("ABSPOSUA",$J)) D  Q
  1.  .W "None" W:$G(USER) " for ",$P(^VA(200,USER,0),U) W ! Q
  1.  S X="" F  S X=$O(^TMP("ABSPOSUA",$J,X)) Q:X=""  D
  1.  .S Y="" F  S Y=$O(^TMP("ABSPOSUA",$J,X,Y)) Q:Y=""  D
  1.  ..S RXI="" F  S RXI=$O(^TMP("ABSPOSUA",$J,X,Y,RXI)) Q:RXI=""  D
  1.  ...N X,Y D DISP1
  1.  Q
  1. TT() Q "S:Y[""."" Y=$P(Y,""."",2) S Y=Y_""000000"" S Y=""@""_$E(Y,1,2)_"":""_$E(Y,3,4)_"":""_$E(Y,5,6)" ; TT is kind of like ^DD("DD") but just for our times
  1. DISP1 ; given RXI
  1.  N REC M REC=^ABSPT(RXI)
  1.  N X,Y
  1.  N TT S TT=$$TT
  1.  F I=0:1:2 I '$D(REC(I)) S REC(I)=""
  1.  N STAT S STAT=$P(REC(0),U,2)
  1.  W "`",RXI," "
  1.  N PAT S PAT=$P(REC(0),U,6)
  1.  I PAT W " ",$P($G(^DPT(PAT,0)),U)," "
  1.  W:STAT'=99 "in Q",STAT,":" W $E($$STATI^ABSPOSU(STAT),1,30)
  1.  S Y=$P($P(REC(0),U,8),".",2) X TT W " ",Y
  1.  I STAT'=99 G DISP99
  1.  D DISPRESP
  1. DISP99 W !
  1.  Q
  1. DISPRESP ;EP - ABSPOS6M
  1.  ; Given REC(2) = result, RXI = prescription
  1.  N RES S RES=$P(REC(2),U)
  1.  I RES=0 D  ; good, go to the claim response and see what it says
  1.  .N RSP D RESPINFO^ABSPOSQ4(RXI,.RSP)
  1.  .I RSP("HDR")'="Accepted" D  ; happily noninteresting if "Accepted"
  1.  ..;ABSP*1.0T7*6 removed erroneous call to SHOULDNT
  1.  ..;W !?10,"Response Status (Header) = ",RSP("HDR"),", " D SHOULDNT W ! ; ABSP*1.0T7*6
  1.  ..W !?10,"Response Status (Header) = ",RSP("HDR") W ! ; ABSP*1.0T7*6
  1.  .W " ",RSP("RSP") ; Payable, Rejected, Captured, Duplicate
  1.  .I RSP("MSG")]"" W !?10,RSP("MSG")
  1.  .N I F I=1:1:RSP("REJ",0) W !?10,RSP("REJ",I)
  1.  E  D
  1.  .W " result: ",RES
  1.  .I $P(REC(2),U,2)]"" W !?5,$P(REC(2),U,2,$L(REC(2),U))
  1.  Q
  1. SHOULDNT W "this should never happen" Q
  1. TDIF(T1,T2)        ; compute time difference T1-T2 = how many seconds
  1.  ;T1,T2 both Fileman date.times
  1.  S T1=$TR($J(T1,16,8)," ","0"),T2=$TR($J(T2,16,8)," ","0")
  1.  N R S R=$P(T1,".")-$P(T2,".")*86400 ; days' difference
  1.  S T1=$P(T1,".",2),T2=$P(T2,".",2) ; hhmmsstt
  1.  S T1=$E(T1,1,2)*60+$E(T1,3,4)*60+$E(T1,5,6)
  1.  S T2=$E(T2,1,2)*60+$E(T2,3,4)*60+$E(T2,5,6)
  1.  I $E(T1,7,8) S T1=$E(T1,7,8)/100+T1
  1.  I $E(T2,7,8) S T2=$E(T2,7,8)/100+T2
  1.  S R=R+T1-T2
  1.  Q R
  1. TADDE D IMPOSS^ABSPOSUE("DB,P","TI","Bad T1="_T1,,"TADD",$T(+0)) Q
  1. TADD(T1,T2)        ; FOR THIS ROUTINE'S USE ONLY - ALL OTHERS USE TADD^ABSPOSUD
  1.  ; add T2 time differential to T1
  1.  ; T2 = number of days.hhmmsstt (mixed, not pure va date)
  1.  N X,X1,X2,%H,%T,%Y,H1,H2,SGN,%
  1.  I T1<0 D TADDE ; but T2 can be negative
  1.  S SGN=$S(T2<0:-1,1:1)
  1.  S X2=$P(T2,".") ; days difference, maybe with sign
  1.  I X2 S X1=T1 D C^%DTC S T1=X
  1.  S $P(T2,".")="",T2=T2_"00000000" ; the days part is done
  1.  ; T2=.hhmmsstt now, positive amount
  1.  I 'T2 Q T1 ; days only, no seconds to compute
  1.  S X=T1 D H^%DTC S $P(%H,",",2)=%T ; %H = T1 in $H format
  1.  ;W "before convert to seconds, T2=",T2,!
  1.  S %=T2,T2=$E(%,2,3)*60+$E(%,4,5)*60+$E(%,6,7)*SGN ; T2 in secs
  1.  ;W "after convert to seconds, T2=",T2,!
  1.  ;W "%H=",%H,", T2=",T2,!
  1.  S $P(%H,",",2)=$P(%H,",",2)+T2 ; add the seconds
  1.  ;W "Add the T2 seconds to %H, giving ",%H
  1. TADDLOOP I $P(%H,",",2)<0 D  G TADDLOOP ; borrow 1 day = 86400 seconds
  1.  . S $P(%H,",")=$P(%H,",")-1,$P(%H,",",2)=$P(%H,",",2)+86400
  1.  E  I $P(%H,",",2)>86400 D  G TADDLOOP ; carry 86400 secs = 1 day
  1.  . S $P(%H,",")=$P(%H,",")+1,$P(%H,",",2)=$P(%H,",",2)-86400
  1.  ;W "any carry/borrow done, and %H=",%H,!
  1.  D YMD^%DTC
  1.  Q X_%