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

ABSPOS6I.m

Go to the documentation of this file.
  1. ABSPOS6I ; IHS/FCS/DRS - Data Entry & Status Disp ;
  1. ;;1.0;PHARMACY POINT OF SALE;;JUN 21, 2001
  1. ;
  1. ; ALL writes of screen lines as follows:
  1. ; IF $$VISIBLE(line) DO WRITE^VALM10(line)
  1. ; When approp., set NODISPLY=true and $$VISIBLE returns false
  1. Q
  1. ; DISPDBG: are we debugging the display?
  1. DISPDBG() Q $P($G(^ABSP(9002313.99,1,"ABSPOS6*")),U)
  1. DISPHIST(MSG,HANG) ; DEBUGGING - to record history and pause
  1. Q:'$$DISPDBG
  1. I '$D(HANG) S HANG=1
  1. D DISPHIST^ABSPOS6H(MSG,HANG)
  1. Q
  1. UPDATE(COUNTER) ;EP - from ABSPOS6A
  1. ; with COUNTER = a count down, -1 for indefinite repeat
  1. N CHGCOUNT S CHGCOUNT=0
  1. N STOP F D Q:$G(STOP)
  1. .D UPD1
  1. .S COUNTER=COUNTER-1 I 'COUNTER S STOP=1 Q
  1. .I '$G(NODISPLY) D
  1. ..D MSG^VALM10("In continuous update mode: press Q to Quit")
  1. ..N X ;R X#1:^TMP("ABSPOS",$J,"FREQ") D MSG^VALM10(" ")
  1. ..;Try doing this single-character read with ^XGKB
  1. ..;I $D(^TMP("XGKEY",$J)) ; possible interference
  1. ..S X=$$READ^XGKB(1,^TMP("ABSPOS",$J,"FREQ"))
  1. ..;I X]"","Qq^^"[X S STOP=1
  1. ..I '$G(DTOUT),X]"","Qq^^"[X S STOP=1
  1. ..N Y F R Y:0 Q:'$T ; clean out typeahead (like mistaken arrow keys)
  1. Q
  1. UPD1 ; one update cycle
  1. N NOW,PAT,RXI,T,CHG,LAST,OLDEST,ONEPAT D
  1. .N %,%H,%I,X D NOW^%DTC S NOW=%
  1. S ONEPAT=^TMP("ABSPOS",$J,"PATIENT")
  1. I ONEPAT D
  1. .S T=^TMP("ABSPOS",$J,"PATIENT TIME")
  1. .S CHG=$$SORT^ABSPOSUA(0,ONEPAT,T,1)
  1. E D
  1. .S T=^TMP("ABSPOS",$J,"LAST UPDATE") ; absolute time on 2nd & subseq
  1. .I T="" S T=^TMP("ABSPOS",$J,"TIME") ; delta time on 1st call
  1. .S ^TMP("ABSPOS",$J,"LAST UPDATE")=NOW ; remember the time you did this
  1. .S CHG=$$SORT^ABSPOSUA(^TMP("ABSPOS",$J,"USER"),,T) ; get changes
  1. S OLDEST=$$TADD^ABSPOSUD(NOW,-^TMP("ABSPOS",$J,"TIME"))
  1. ;
  1. ; Deal with dismissals
  1. ;
  1. S PAT="" F S PAT=$O(@DISMISS@(PAT)) Q:PAT="" D
  1. .I PAT'?1"*".E,'ONEPAT Q
  1. .I @DISMISS@(PAT)<OLDEST K @DISMISS@(PAT) Q ; dismissal order expired
  1. .I '$D(@CHG@(PAT)) Q ; no changes for this patient
  1. .S RXI="" F S RXI=$O(@DISMISS@(PAT,RXI)) Q:RXI="" D
  1. ..I @DISMISS@(PAT,RXI)<OLDEST K @DISMISS@(PAT,RXI) Q ; order expired
  1. ..I $D(@CHG@(PAT,RXI)) D ; a change has occurred in a dismissed RX
  1. ...K @CHG@(PAT,RXI) ; so ignore the change
  1. ...I $O(@CHG@(PAT,""))="" K @CHG@(PAT) ; and maybe patient is empty
  1. S CHGCOUNT=$G(CHGCOUNT)+1
  1. I $$DISPDBG D
  1. . D DISPHIST("CHGCOUNT="_CHGCOUNT_" computed with T="_T)
  1. . K ^TMP("ABSPOS",$J,"CHG",CHGCOUNT)
  1. . M ^TMP("ABSPOS",$J,"CHG",CHGCOUNT)=@CHG
  1. ; And you have DISP,DISPLINE,DISPIDX already set up from caller
  1. ;
  1. ; Now deal with any surviving changes
  1. ;
  1. S PAT="" F S PAT=$O(@CHG@(PAT)) Q:PAT="" D UPDPAT
  1. ;
  1. ; And finally, weed out any which haven't seen any changes
  1. ; in the last ^TMP("ABSPOS",$J,"TIME") time
  1. ;
  1. I 'ONEPAT S PAT="" F S PAT=$O(@DISP@(PAT)) Q:PAT="" D
  1. .S X=@DISP@(PAT),LAST=$P(X,U,3) ; last update for this patient
  1. .I LAST<OLDEST,$P(X,U,4)*100=$P(X,U,2) D ; old & complete
  1. ..D DISPHIST("Deleting "_PAT_" "_LAST_"<"_OLDEST)
  1. ..N NLINES S NLINES=$P(X,U,4)+1 ; how many line this one occupies
  1. ..D SHIFTUP($P(X,U)+NLINES,$P(X,U)) ;
  1. ..K @DISP@(PAT)
  1. Q
  1. UPDPAT ; Update for a given @CHG@(PAT)
  1. ;I $P($G(^ABSP(9002313.99,1,"ABSPOS6*")),U,2) S $ZT="ERR^ZU"
  1. N NEWPAT,RXI,I
  1. N PATCHG S PATCHG=0 ; "patient changed", set to 1 if so
  1. D DISPHIST("UPDPAT for PAT="_PAT,0)
  1. ;
  1. I $D(@DISP@(PAT)) S NEWPAT=0 G UPD2 ; nope, we already have them
  1. ;
  1. D DISPHIST("New patient not yet on our list",0)
  1. S (NEWPAT,PATCHG)=1 ; set "new patient" flag
  1. N NPRESC S NPRESC=@CHG@(PAT) ; how many prescriptions
  1. N NLINES S NLINES=NPRESC+1 ; plus one more line for the patient
  1. I VALMCNT+NLINES>^TMP("ABSPOS",$J,"MAX LINES") Q ; overflow
  1. N PATNEXT S PATNEXT=$O(@DISP@(PAT))
  1. I PATNEXT="" D ; the new patient and prescriptions go at end
  1. .S LINE=@DISPLINE+1 ; this is the new line number
  1. .S (VALMCNT,@DISPLINE)=@DISPLINE+NLINES ; update count of total lines
  1. .D DISPHIST("Goes at end, on line #"_LINE,0)
  1. E D ; the new patient pushes the next one downward
  1. .D DISPHIST("Pushes existing ones at line "_LINE_" down "_NLINES,1)
  1. .S LINE=$P(@DISP@(PATNEXT),U)
  1. .D SHIFTDN(LINE,NLINES)
  1. ;
  1. ; common handling for new patient, whether at end or not
  1. ;
  1. S @DISP@(PAT)=LINE_U_U_U_NPRESC
  1. S @DISPLINE@(LINE)=PAT_U ; remember who's stored here
  1. ;
  1. ; Init for each prescription that came with this new patient
  1. ;
  1. S RXI="" ; should always get @CHG@(PAT) iterations, right?
  1. F I=1:1:@CHG@(PAT) S RXI=$O(@CHG@(PAT,"RXI",RXI)) Q:RXI="" D
  1. .S @DISP@(PAT,RXI)=(LINE+I)_U_U
  1. .S @DISPLINE@(LINE+I)=PAT_U_RXI
  1. ;
  1. ; and fall through to treat the rest of it same as existing patient
  1. G UPD3
  1. UPD2 ;
  1. ; Patient was already in our list, but maybe there are
  1. ; new prescriptions for which we must make room
  1. ;
  1. S RXI="" F I=1:1:@CHG@(PAT) S RXI=$O(@CHG@(PAT,"RXI",RXI)) D
  1. .Q:$D(@DISP@(PAT,RXI)) ; prescription already has a spot
  1. .I VALMCNT+1>^TMP("ABSPOS",$J,"MAX LINES") Q ; overflow
  1. .N I ; protect index
  1. .D DISPHIST("New prescription "_RXI_" for "_PAT,0)
  1. .;
  1. .; a new prescription for the already-existent patient
  1. .; assign a line for it and shift everything else down
  1. .;
  1. .S PATCHG=1 ; flag: "patient info has changed"
  1. .N ADDATEND
  1. .N RXINEXT S RXINEXT=$O(@DISP@(PAT,RXI))
  1. .I RXINEXT S LINE=$P(@DISP@(PAT,RXINEXT),U),ADDATEND=0
  1. .E D ; prescription comes at end of this patient's stuff
  1. ..N PATNEXT S PATNEXT=$O(@DISP@(PAT))
  1. ..I PATNEXT="" S ADDATEND=1
  1. ..E S LINE=$P(@DISP@(PATNEXT),U),ADDATEND=0
  1. .I ADDATEND D ; adding at end, nothing needs to be shifted down
  1. ..S LINE=@DISPLINE+1,(VALMCNT,@DISPLINE)=@DISPLINE+1
  1. .E D ; adding in the middle or beginning; need to shift down
  1. ..D SHIFTDN(LINE,1)
  1. .;
  1. .; no matter where we added the new prescription, do the following:
  1. .;
  1. .S @DISP@(PAT,RXI)=LINE_U_U
  1. .S @DISPLINE@(LINE)=PAT_U_RXI ; 02/02/2000
  1. .S $P(@DISP@(PAT),U,4)=$P(@DISP@(PAT),U,4)+1
  1. ;
  1. UPD3 ; this patient is already in our list (maybe having just been added)
  1. ; The patient and all of his prescriptions have display space
  1. ; Now we can deal with the actual changes (date-time of change,status)
  1. ;I $P($G(^ABSP(9002313.99,1,"ABSPOS6*")),U,2) S $ZT="ERR^ZU"
  1. S RXI="" F I=1:1:@CHG@(PAT) D
  1. .;K ^ABSTMP("ABSPOS SAVE",$J) M ^ABSTMP("ABSPOS SAVE",$J)=^TMP("ABSPOS",$J) ; TEMPORARY TEMPORARY TEMPORARY
  1. .S RXI=$O(@CHG@(PAT,"RXI",RXI)) ; next changed prescription
  1. .N X S X=@CHG@(PAT,"RXI",RXI) ; status^dateTimeof last change
  1. .;D DISPHIST("UPD3:"_PAT_" "_RXI_":"_X)
  1. .I '$D(@DISP@(PAT,RXI)) D LOGERR^ABSPOS6F("UPD3^ABSPOS") ; 01/27/2000
  1. .I X=$P(@DISP@(PAT,RXI),U,2,3) D Q ; we saw this last time around
  1. ..D DISPHIST("UPD3: already processed this one, so quit early")
  1. UPD4 .N S,D S S=$P(X,U),D=$P(X,U,2)
  1. .; NO! I D>^TMP("ABSPOS",$J,"LAST UPDATE") S ^("LAST UPDATE")=D
  1. .;D DISPHIST("UPD3: reset LAST UPDATE to "_D)
  1. .N L S L=$P(@DISP@(PAT,RXI),U) ; line #
  1. UPD5 .I S=100,$P(@DISP@(PAT,RXI),U,2)'=100 D ; marking as complete
  1. ..N B S B=$$BUCKET^ABSPOS6B(RXI)
  1. ..; NO! S $P(@DISP@(PAT),U,4)=$P(@DISP@(PAT),U,4)+1
  1. ..S $P(@DISP@(PAT),U,B)=$P(@DISP@(PAT),U,B)+1
  1. .S @DISP@(PAT,RXI)=L_U_S_U_D ; line^status^dateTime of change
  1. .;D DISPHIST("UPD3: PAT REC BEFORE:"_@DISP@(PAT))
  1. UPD6 .I D>$P(@DISP@(PAT),U,3) S $P(@DISP@(PAT),U,3)=D,PATCHG=1
  1. .;D DISPHIST("UPD3: PAT REC AFTER:"_@DISP@(PAT))
  1. .D SETLINE^ABSPOS6H(L,PAT,RXI) ; update list manager data and disp. if visible
  1. ;
  1. UPD7 ; Sum the total of the statuses - used for computing %done
  1. N TOTSTAT S TOTSTAT=0
  1. S RXI="" F I=1:1:$P(@DISP@(PAT),U,4) D
  1. .S RXI=$O(@DISP@(PAT,RXI))
  1. .S TOTSTAT=TOTSTAT+$P(@DISP@(PAT,RXI),U,2)
  1. I TOTSTAT'=$P(@DISP@(PAT),U,2) S PATCHG=1 ; total of statuses changed
  1. S $P(@DISP@(PAT),U,2)=TOTSTAT
  1. D DISPHIST("After summing:"_@DISP@(PAT))
  1. ;
  1. ; If the patient data changed, update the list manager data and
  1. ; if the line is visible, update the display, too
  1. ;
  1. I PATCHG D SETLINE^ABSPOS6H($P(@DISP@(PAT),U),PAT)
  1. Q
  1. VISIBLE(LINE) ;EP - from ABSPOS6H - is LINE number visible?
  1. ; HARDCODED!!! list region is from line 6 to line 18
  1. ; ASSUMPTION!! VALMBG is the first line number displayed
  1. ; so lines VALMBG through VALMBG+(18-6) are visitble
  1. I $G(NODISPLY) Q 0
  1. I '$G(VALMBG) Q 0
  1. I LINE<VALMBG Q 0
  1. I LINE>(VALMBG+(18-6)) Q 0
  1. Q 1
  1. SHIFTDN(LINE,NLINES) ; as in when something is inserted
  1. D DISPHIST("SHIFTDN(LINE,NLINES) for "_LINE_","_NLINES)
  1. F I=VALMCNT:-1:LINE D
  1. .D MOVELINE(I,I+NLINES)
  1. S (@DISPLINE,VALMCNT)=VALMCNT+NLINES
  1. Q
  1. MOVELINE(FROM,TO,CLR) ;
  1. D DISPHIST("Move line "_FROM_" to "_TO_";visible="_$$VISIBLE(TO)_","_$$VISIBLE(FROM))
  1. D DISPHIST("VALMAR="_VALMAR)
  1. M @DISPHIST@(@DISPHIST,"VALMAR")=@VALMAR
  1. ;I $P($G(^ABSP(9002313.99,1,"ABSPOS6*")),U,2) S $ZT="ERR^ZU"
  1. I '$D(@DISPLINE@(FROM)) D LOGERR^ABSPOS6F("MOVELINE^ABSPOS") ;01/27/2000
  1. N PAT,RXI,X S X=@DISPLINE@(FROM),PAT=$P(X,U),RXI=$P(X,U,2)
  1. I $G(RXI) S $P(@DISP@(PAT,RXI),U)=TO
  1. E S $P(@DISP@(PAT),U)=TO
  1. S @DISPLINE@(TO)=@DISPLINE@(FROM)
  1. D SET^VALM10(TO,@VALMAR@(FROM,0),TO) ; set destination = new contents
  1. D FLDTEXT^VALM10(TO,"LINE NUMBER",$J(TO,2)) ; fix line number in dest
  1. I $$VISIBLE(TO) D WRITE^VALM10(TO) ; if any visible, write them
  1. I $G(CLR) D CLRLINE(FROM)
  1. D DISPHIST("Move line "_FROM_" to "_TO_" complete")
  1. Q
  1. CLRLINE(N) ; clear out line N
  1. D DISPHIST("Clearing line "_N_", $$VISIBLE(N)="_$$VISIBLE(N))
  1. D SET^VALM10(N," ") ; clear contents of source line
  1. I $$VISIBLE(N) D WRITE^VALM10(N)
  1. S @DISPLINE@(N)="DELETED "_@DISPLINE@(N)
  1. K @VALMAR@("IDX",N)
  1. Q
  1. SHIFTUP(FROM,TO) ; move upward from SRC to DST, all the way to end
  1. D DISPHIST("SHIFTUP(FROM,TO) for "_FROM_","_TO)
  1. I FROM'>TO D Q
  1. . D IMPOSS^ABSPOSUE("P","TI","bad params FROM="_FROM_",TO="_TO,,"SHIFTUP",$T(+0))
  1. N NLINES S NLINES=FROM-TO
  1. F Q:FROM>VALMCNT D
  1. .D MOVELINE(FROM,TO,0)
  1. .S FROM=FROM+1,TO=TO+1
  1. F D CLRLINE(TO) Q:TO=VALMCNT S TO=TO+1
  1. S (VALMCNT,@DISPLINE)=VALMCNT-NLINES
  1. Q