ABSPOS6H ; IHS/FCS/DRS - Data Entry & Status Disp ;
;;1.0;PHARMACY POINT OF SALE;**10**;JUN 21, 2001;Build 38
; continuation of ABSPOS6A:
; SETLINE, INFOCT, COMMENTS
;-----------------------------------------------------------------
;IHS/SD/lwj 3/10/04 patch 10 V1.0
;Cherokee reported a problem with the selection process
; on the List Manager screen. The problem was isolated
; to the occasion when the patient's IEN was less than the
; number of claims to display. The selection prompt would
; limit the user to the patient's IEN. (i.e. IEN = 5,
; select prompt would remain at 5-5 even if there were
; 100 claims to select from.) The problem was traced
; to the additional entry:
; ^TMP("ABSPOS",$J,"VALM","IDX",LINE,INFO("PATIEN"),RXI)
; While the:
; ^TMP("ABSPOS",$J,"VALM","IDX",LINE,INFO("PATIENT")
; entry is setup and used by list manager, the other entry
; appeared to be bogus and may have been used when the
; screen was first set up. No other references were made
; to the "RXI" entry in any of the POS programs, so it was
; remarked from this routine where it was defined.
;-------------------------------------------------------------
;
Q
SETLINE(LINE,PAT,RXI) ;EP - from ABSPOS6I
; set up given line# in array for given PAT name; R root
; LINE # in array to set
; PAT = which patient
; RXI: if present, set this up as a prescription line
; if missing, set this up as a patient line
N %,X,INFO D INFO^ABSPOS6B(PAT,$G(RXI)) ; Set INFO(*) array
;
; Setting up - common to both patient and prescription lines:
; X is started; whatever branch you go to will build on X
;
SETL1 K ^TMP("ABSPOS",$J,"VALM","IDX",LINE) ; indexing for ^VALM2 call
S X=$$SETFLD^VALM1($J(LINE,2),"","LINE NUMBER")
;
; Setting up for a prescription line:
;
SETL2 I $G(RXI) D
.I LINE="" D
. . D IMPOSS^ABSPOSUE("P","TI","LINE null",,"SETL2",$T(+0))
.I INFO("PATIEN")="" D
. . D IMPOSS^ABSPOSUE("P","TI","INFO(""PATIEN"") null",,"SETL2",$T(+0))
.I RXI="" D
. . D IMPOSS^ABSPOSUE("P","TI","RXI null",,"SETL2",$T(+0))
.;
.;IHS/SD/lwj 3/10/04 patch 10 nxt line remrked out
.;S ^TMP("ABSPOS",$J,"VALM","IDX",LINE,INFO("PATIEN"),RXI)=""
.;
.S X=$$SETFLD^VALM1(INFO("DRUG"),X,"PATIENT") ; drug name
.N C S C=INFO("RES") ; this will be either status or result
.; DO INFO also tacked on the prescription number
.S X=$$SETFLD^VALM1(C,X,"COMMENTS")
.I $L(C)>80 S X=$$SETFLD^VALM1($E(C,81,160),X,"COMMENTS 2")
.I $L(C)>160 S X=$$SETFLD^VALM1($E(C,161,$L(C)),X,"COMMENTS 3")
;
; Setting up for a patient line:
;
SETL3 E D
.S ^TMP("ABSPOS",$J,"VALM","IDX",LINE,INFO("PATIEN"))=""
.I INFO("%")=100 S INFO("%")="done"
.E S INFO("%")=" "_$J(INFO("%"),2)_"%"
.S X=$$SETFLD^VALM1(INFO("%"),X,"PERCENT DONE")
.S X=$$SETFLD^VALM1(PAT,X,"PATIENT")
.N C S C=INFO("RES") ;$S(INFO("%")="done":$$COMMENTS,1:INFO("RES"))
.S X=$$SETFLD^VALM1($E(C,1,80),X,"COMMENTS")
.I $L(C)>80 S X=$$SETFLD^VALM1($E(C,81,160),X,"COMMENTS 2")
.I $L(C)>160 S X=$$SETFLD^VALM1($E(C,161,210),X,"COMMENTS 3")
SETL9 D SET^VALM10(LINE,X,LINE)
I $$VISIBLE^ABSPOS6I(LINE) D WRITE^VALM10(LINE)
Q
INFOCT(N) ; how many of these things?
I INFO("COUNT")=1 Q "" ; only one, so we display no count
I N=INFO("COUNT") Q "ALL " ; more than one and they're all this way
Q N_" "
N %,A,M,X,Y S %="",M=255 ; M = max length
; start with results
I $O(INFO("RES",""))]"" D ;S %="RESULTS: " D
.S A="" F S A=$O(INFO("RES",A)) Q:A="" D
..;S X=$P(A,U),Y=$P(A,U,2,$L(A,U)) ; X = result code, Y = text
..S %=%_$$INFOCT(INFO("RES",A)) ; how many of them
..;I Y]"" S %=%_Y ; with this status
..;E S %=%_"result code "_X
..S %=%_A
..S %=%_"; "
..I $L(%)>M S %=$E(%,1,$L(M))
; tack on statuses
I INFO("%")'="done" D
.S %=%_"STATUS: "
.S A="" F S A=$O(INFO("STAT",A)) Q:A="" D
..S %=%_$$INFOCT(INFO("STAT",A))_$$STATI^ABSPOSU(A)_"; " ; count,text
..I $L(%)>M S %=$E(%,1,$L(M))
I %?.E1"; " S %=$E(%,1,253)
Q %
DISPHIST(MSG,HANG) ;EP - DEBUGGING - to record history and pause
Q:'$P($G(^ABSP(9002313.99,1,"ABSPOS6*")),U)
S @DISPHIST=@DISPHIST+1
S @DISPHIST@(@DISPHIST)=MSG
Q:'$G(HANG)!$G(NODISPLY)
D MSG^VALM10(MSG)
HANG HANG
D MSG^VALM10("")
Q
ABSPOS6H ; IHS/FCS/DRS - Data Entry & Status Disp ;
+1 ;;1.0;PHARMACY POINT OF SALE;**10**;JUN 21, 2001;Build 38
+2 ; continuation of ABSPOS6A:
+3 ; SETLINE, INFOCT, COMMENTS
+4 ;-----------------------------------------------------------------
+5 ;IHS/SD/lwj 3/10/04 patch 10 V1.0
+6 ;Cherokee reported a problem with the selection process
+7 ; on the List Manager screen. The problem was isolated
+8 ; to the occasion when the patient's IEN was less than the
+9 ; number of claims to display. The selection prompt would
+10 ; limit the user to the patient's IEN. (i.e. IEN = 5,
+11 ; select prompt would remain at 5-5 even if there were
+12 ; 100 claims to select from.) The problem was traced
+13 ; to the additional entry:
+14 ; ^TMP("ABSPOS",$J,"VALM","IDX",LINE,INFO("PATIEN"),RXI)
+15 ; While the:
+16 ; ^TMP("ABSPOS",$J,"VALM","IDX",LINE,INFO("PATIENT")
+17 ; entry is setup and used by list manager, the other entry
+18 ; appeared to be bogus and may have been used when the
+19 ; screen was first set up. No other references were made
+20 ; to the "RXI" entry in any of the POS programs, so it was
+21 ; remarked from this routine where it was defined.
+22 ;-------------------------------------------------------------
+23 ;
+24 QUIT
SETLINE(LINE,PAT,RXI) ;EP - from ABSPOS6I
+1 ; set up given line# in array for given PAT name; R root
+2 ; LINE # in array to set
+3 ; PAT = which patient
+4 ; RXI: if present, set this up as a prescription line
+5 ; if missing, set this up as a patient line
+6 ; Set INFO(*) array
NEW %,X,INFO
DO INFO^ABSPOS6B(PAT,$GET(RXI))
+7 ;
+8 ; Setting up - common to both patient and prescription lines:
+9 ; X is started; whatever branch you go to will build on X
+10 ;
SETL1 ; indexing for ^VALM2 call
KILL ^TMP("ABSPOS",$JOB,"VALM","IDX",LINE)
+1 SET X=$$SETFLD^VALM1($JUSTIFY(LINE,2),"","LINE NUMBER")
+2 ;
+3 ; Setting up for a prescription line:
+4 ;
SETL2 IF $GET(RXI)
Begin DoDot:1
+1 IF LINE=""
Begin DoDot:2
+2 DO IMPOSS^ABSPOSUE("P","TI","LINE null",,"SETL2",$TEXT(+0))
End DoDot:2
+3 IF INFO("PATIEN")=""
Begin DoDot:2
+4 DO IMPOSS^ABSPOSUE("P","TI","INFO(""PATIEN"") null",,"SETL2",$TEXT(+0))
End DoDot:2
+5 IF RXI=""
Begin DoDot:2
+6 DO IMPOSS^ABSPOSUE("P","TI","RXI null",,"SETL2",$TEXT(+0))
End DoDot:2
+7 ;
+8 ;IHS/SD/lwj 3/10/04 patch 10 nxt line remrked out
+9 ;S ^TMP("ABSPOS",$J,"VALM","IDX",LINE,INFO("PATIEN"),RXI)=""
+10 ;
+11 ; drug name
SET X=$$SETFLD^VALM1(INFO("DRUG"),X,"PATIENT")
+12 ; this will be either status or result
NEW C
SET C=INFO("RES")
+13 ; DO INFO also tacked on the prescription number
+14 SET X=$$SETFLD^VALM1(C,X,"COMMENTS")
+15 IF $LENGTH(C)>80
SET X=$$SETFLD^VALM1($EXTRACT(C,81,160),X,"COMMENTS 2")
+16 IF $LENGTH(C)>160
SET X=$$SETFLD^VALM1($EXTRACT(C,161,$LENGTH(C)),X,"COMMENTS 3")
End DoDot:1
+17 ;
+18 ; Setting up for a patient line:
+19 ;
SETL3 IF '$TEST
Begin DoDot:1
+1 SET ^TMP("ABSPOS",$JOB,"VALM","IDX",LINE,INFO("PATIEN"))=""
+2 IF INFO("%")=100
SET INFO("%")="done"
+3 IF '$TEST
SET INFO("%")=" "_$JUSTIFY(INFO("%"),2)_"%"
+4 SET X=$$SETFLD^VALM1(INFO("%"),X,"PERCENT DONE")
+5 SET X=$$SETFLD^VALM1(PAT,X,"PATIENT")
+6 ;$S(INFO("%")="done":$$COMMENTS,1:INFO("RES"))
NEW C
SET C=INFO("RES")
+7 SET X=$$SETFLD^VALM1($EXTRACT(C,1,80),X,"COMMENTS")
+8 IF $LENGTH(C)>80
SET X=$$SETFLD^VALM1($EXTRACT(C,81,160),X,"COMMENTS 2")
+9 IF $LENGTH(C)>160
SET X=$$SETFLD^VALM1($EXTRACT(C,161,210),X,"COMMENTS 3")
End DoDot:1
SETL9 DO SET^VALM10(LINE,X,LINE)
+1 IF $$VISIBLE^ABSPOS6I(LINE)
DO WRITE^VALM10(LINE)
+2 QUIT
INFOCT(N) ; how many of these things?
+1 ; only one, so we display no count
IF INFO("COUNT")=1
QUIT ""
+2 ; more than one and they're all this way
IF N=INFO("COUNT")
QUIT "ALL "
+3 QUIT N_" "
+1 ; M = max length
NEW %,A,M,X,Y
SET %=""
SET M=255
+2 ; start with results
+3 ;S %="RESULTS: " D
IF $ORDER(INFO("RES",""))]""
Begin DoDot:1
+4 SET A=""
FOR
SET A=$ORDER(INFO("RES",A))
IF A=""
QUIT
Begin DoDot:2
+5 ;S X=$P(A,U),Y=$P(A,U,2,$L(A,U)) ; X = result code, Y = text
+6 ; how many of them
SET %=%_$$INFOCT(INFO("RES",A))
+7 ;I Y]"" S %=%_Y ; with this status
+8 ;E S %=%_"result code "_X
+9 SET %=%_A
+10 SET %=%_"; "
+11 IF $LENGTH(%)>M
SET %=$EXTRACT(%,1,$LENGTH(M))
End DoDot:2
End DoDot:1
+12 ; tack on statuses
+13 IF INFO("%")'="done"
Begin DoDot:1
+14 SET %=%_"STATUS: "
+15 SET A=""
FOR
SET A=$ORDER(INFO("STAT",A))
IF A=""
QUIT
Begin DoDot:2
+16 ; count,text
SET %=%_$$INFOCT(INFO("STAT",A))_$$STATI^ABSPOSU(A)_"; "
+17 IF $LENGTH(%)>M
SET %=$EXTRACT(%,1,$LENGTH(M))
End DoDot:2
End DoDot:1
+18 IF %?.E1"; "
SET %=$EXTRACT(%,1,253)
+19 QUIT %
DISPHIST(MSG,HANG) ;EP - DEBUGGING - to record history and pause
+1 IF '$PIECE($GET(^ABSP(9002313.99,1,"ABSPOS6*")),U)
QUIT
+2 SET @DISPHIST=@DISPHIST+1
+3 SET @DISPHIST@(@DISPHIST)=MSG
+4 IF '$GET(HANG)!$GET(NODISPLY)
QUIT
+5 DO MSG^VALM10(MSG)
+6 HANG HANG
+7 DO MSG^VALM10("")
+8 QUIT
