102 lines
2.9 KiB
Mathematica
102 lines
2.9 KiB
Mathematica
PSOREJP3 ;ALB/SS - Third Party Reject Display Screen - Comments ;10/27/06
|
|
;;7.0;OUTPATIENT PHARMACY;**260**;DEC 1997;Build 84
|
|
;
|
|
COM ; Builds the Comments section in the Reject Display Screen
|
|
I +$O(^PSRX(RX,"REJ",REJ,"COM",0))=0 Q
|
|
D SETLN^PSOREJP1()
|
|
D SETLN^PSOREJP1("COMMENTS",1,1)
|
|
N DIWL,DIWR,LNCNT,MAXLN,PSL
|
|
N I,X,PSI,Y,LAST,PSOCOM,TXTLN
|
|
S PSI=999999
|
|
F S PSI=$O(^PSRX(RX,"REJ",REJ,"COM",PSI),-1) Q:+PSI=0 D
|
|
. S PSCOM=$$GET1^DIQ(52.2551,PSI_","_REJ_","_RX,.01)_" - "
|
|
. S PSCOM=PSCOM_$$GET1^DIQ(52.2551,PSI_","_REJ_","_RX,2)
|
|
. S PSCOM=PSCOM_" ("_$$GET1^DIQ(52.2551,PSI_","_REJ_","_RX,1)_")"
|
|
. ;display comment
|
|
. K ^UTILITY($J,"W") S X=PSCOM,DIWL=1,DIWR=78 D ^DIWP
|
|
. F PSL=1:1 Q:('$D(^UTILITY($J,"W",1,PSL,0))) D
|
|
. . S LAST=0 I '$D(^UTILITY($J,"W",1,PSL+1)),'$O(^PSRX(RX,"REJ",REJ,"COM",PSI),-1) S LAST=1
|
|
. . S TXTLN=$G(^UTILITY($J,"W",1,PSL,0))
|
|
. . D SETLN^PSOREJP1($S(PSL=1:"- ",1:" ")_TXTLN,0,$S(LAST:1,1:0),1)
|
|
K ^UTILITY($J,"W")
|
|
Q
|
|
;
|
|
ADDCOM ; - Add comment worklist action
|
|
N PSCOM
|
|
D FULL^VALM1
|
|
S PSCOM=$$COMMENT("Comment: ",150)
|
|
I $L(PSCOM)>0,PSCOM'["^" D
|
|
. D SAVECOM(RX,REJ,PSCOM) ;save the comment
|
|
. D INIT^PSOREJP1 ;update screen
|
|
S VALMBCK="R"
|
|
Q
|
|
;
|
|
;Enter a comment
|
|
;PSOTR -prompt string
|
|
;PSMLEN -maxlen
|
|
;returns:
|
|
; "^" - if user chose to quit
|
|
; "" - nothing entered or input has been discarded
|
|
; otherwise - comment's text
|
|
COMMENT(PSOTR,PSMLEN) ;*/
|
|
N DIR,DTOUT,DUOUT,PSQ
|
|
I '$D(PSOTR) S PSOTR="Comment "
|
|
I '$D(PSMLEN) S PSMLEN=150
|
|
S DIR(0)="FA^1:150"
|
|
S DIR("A")=PSOTR
|
|
S DIR("?")="Enter a free text comment up to 150 characters long."
|
|
S PSQ=0
|
|
F D Q:+PSQ'=0
|
|
. W ! D ^DIR
|
|
. I $D(DUOUT)!($D(DTOUT)) S PSQ=-1 Q
|
|
. I $L(Y)'>PSMLEN S PSQ=1 Q
|
|
. W !!,"Enter a free text comment up to 150 characters long.",!
|
|
. S DIR("B")=$E(Y,1,PSMLEN)
|
|
Q:PSQ<0 "^"
|
|
Q:$L(Y)=0 ""
|
|
S PSQ=$$YESNO("Confirm","YES")
|
|
I PSQ=-1 Q "^"
|
|
I PSQ=0 Q ""
|
|
Q Y
|
|
;
|
|
; Ask
|
|
; Input:
|
|
; PSQSTR - question
|
|
; PSDFL - default answer
|
|
; Output:
|
|
; 1 YES
|
|
; 0 NO
|
|
; -1 if cancelled
|
|
YESNO(PSQSTR,PSDFL) ; Default - YES
|
|
N DIR,Y,DUOUT
|
|
S DIR(0)="Y"
|
|
S DIR("A")=PSQSTR
|
|
S:$L($G(PSDFL)) DIR("B")=PSDFL
|
|
W ! D ^DIR
|
|
Q $S($G(DUOUT)!$G(DUOUT)!(Y="^"):-1,1:Y)
|
|
;
|
|
;Save comment
|
|
SAVECOM(PSRXIEN,PSREJIEN,PSCOMNT,DATETIME,USER) ;
|
|
N PSREC,PSDA,PSERR
|
|
I '$G(DATETIME) D NOW^%DTC S DATETIME=%
|
|
I '$G(USER) S USER=DUZ
|
|
D INSITEM(52.2551,PSRXIEN,PSREJIEN,DATETIME)
|
|
S PSREC=$O(^PSRX(PSRXIEN,"REJ",PSREJIEN,"COM","B",DATETIME,0))
|
|
I PSREC>0 D
|
|
. S PSDA(52.2551,PSREC_","_PSREJIEN_","_PSRXIEN_",",1)=USER
|
|
. S PSDA(52.2551,PSREC_","_PSREJIEN_","_PSRXIEN_",",2)=$G(PSCOMNT)
|
|
. D FILE^DIE("","PSDA","PSERR")
|
|
Q
|
|
;
|
|
;/**
|
|
;PSSFILE - subfile# (52.2551) for comment
|
|
;PSIEN - ien for file in which the new subfile entry will be inserted
|
|
;PSVAL01 - .01 value for the new entry
|
|
INSITEM(PSSFILE,PSIEN0,PSIEN1,PSVAL01) ;*/
|
|
N PSSSI,PSIENS,PSFDA,PSER
|
|
S PSIENS="+1,"_PSIEN1_","_PSIEN0_","
|
|
S PSFDA(PSSFILE,PSIENS,.01)=PSVAL01
|
|
D UPDATE^DIE("","PSFDA","PSSSI","PSER")
|
|
I $D(PSER) D BMES^XPDUTL(PSER("DIERR",1,"TEXT",1))
|
|
Q
|