source: FOIAVistA/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOREJP3.m@ 847

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