source: WorldVistAEHR/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOREJP3.m@ 1464

Last change on this file since 1464 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 2.9 KB
RevLine 
[613]1PSOREJP3 ;ALB/SS - Third Party Reject Display Screen - Comments ;10/27/06
2 ;;7.0;OUTPATIENT PHARMACY;**260**;DEC 1997;Build 84
3 ;
4COM ; Builds the Comments section in the Reject Display Screen
5 I +$O(^PSRX(RX,"REJ",REJ,"COM",0))=0 Q
6 D SETLN^PSOREJP1()
7 D SETLN^PSOREJP1("COMMENTS",1,1)
8 N DIWL,DIWR,LNCNT,MAXLN,PSL
9 N I,X,PSI,Y,LAST,PSOCOM,TXTLN
10 S PSI=999999
11 F S PSI=$O(^PSRX(RX,"REJ",REJ,"COM",PSI),-1) Q:+PSI=0 D
12 . S PSCOM=$$GET1^DIQ(52.2551,PSI_","_REJ_","_RX,.01)_" - "
13 . S PSCOM=PSCOM_$$GET1^DIQ(52.2551,PSI_","_REJ_","_RX,2)
14 . S PSCOM=PSCOM_" ("_$$GET1^DIQ(52.2551,PSI_","_REJ_","_RX,1)_")"
15 . ;display comment
16 . K ^UTILITY($J,"W") S X=PSCOM,DIWL=1,DIWR=78 D ^DIWP
17 . F PSL=1:1 Q:('$D(^UTILITY($J,"W",1,PSL,0))) D
18 . . S LAST=0 I '$D(^UTILITY($J,"W",1,PSL+1)),'$O(^PSRX(RX,"REJ",REJ,"COM",PSI),-1) S LAST=1
19 . . S TXTLN=$G(^UTILITY($J,"W",1,PSL,0))
20 . . D SETLN^PSOREJP1($S(PSL=1:"- ",1:" ")_TXTLN,0,$S(LAST:1,1:0),1)
21 K ^UTILITY($J,"W")
22 Q
23 ;
24ADDCOM ; - Add comment worklist action
25 N PSCOM
26 D FULL^VALM1
27 S PSCOM=$$COMMENT("Comment: ",150)
28 I $L(PSCOM)>0,PSCOM'["^" D
29 . D SAVECOM(RX,REJ,PSCOM) ;save the comment
30 . D INIT^PSOREJP1 ;update screen
31 S VALMBCK="R"
32 Q
33 ;
34 ;Enter a comment
35 ;PSOTR -prompt string
36 ;PSMLEN -maxlen
37 ;returns:
38 ; "^" - if user chose to quit
39 ; "" - nothing entered or input has been discarded
40 ; otherwise - comment's text
41COMMENT(PSOTR,PSMLEN) ;*/
42 N DIR,DTOUT,DUOUT,PSQ
43 I '$D(PSOTR) S PSOTR="Comment "
44 I '$D(PSMLEN) S PSMLEN=150
45 S DIR(0)="FA^1:150"
46 S DIR("A")=PSOTR
47 S DIR("?")="Enter a free text comment up to 150 characters long."
48 S PSQ=0
49 F D Q:+PSQ'=0
50 . W ! D ^DIR
51 . I $D(DUOUT)!($D(DTOUT)) S PSQ=-1 Q
52 . I $L(Y)'>PSMLEN S PSQ=1 Q
53 . W !!,"Enter a free text comment up to 150 characters long.",!
54 . S DIR("B")=$E(Y,1,PSMLEN)
55 Q:PSQ<0 "^"
56 Q:$L(Y)=0 ""
57 S PSQ=$$YESNO("Confirm","YES")
58 I PSQ=-1 Q "^"
59 I PSQ=0 Q ""
60 Q Y
61 ;
62 ; Ask
63 ; Input:
64 ; PSQSTR - question
65 ; PSDFL - default answer
66 ; Output:
67 ; 1 YES
68 ; 0 NO
69 ; -1 if cancelled
70YESNO(PSQSTR,PSDFL) ; Default - YES
71 N DIR,Y,DUOUT
72 S DIR(0)="Y"
73 S DIR("A")=PSQSTR
74 S:$L($G(PSDFL)) DIR("B")=PSDFL
75 W ! D ^DIR
76 Q $S($G(DUOUT)!$G(DUOUT)!(Y="^"):-1,1:Y)
77 ;
78 ;Save comment
79SAVECOM(PSRXIEN,PSREJIEN,PSCOMNT,DATETIME,USER) ;
80 N PSREC,PSDA,PSERR
81 I '$G(DATETIME) D NOW^%DTC S DATETIME=%
82 I '$G(USER) S USER=DUZ
83 D INSITEM(52.2551,PSRXIEN,PSREJIEN,DATETIME)
84 S PSREC=$O(^PSRX(PSRXIEN,"REJ",PSREJIEN,"COM","B",DATETIME,0))
85 I PSREC>0 D
86 . S PSDA(52.2551,PSREC_","_PSREJIEN_","_PSRXIEN_",",1)=USER
87 . S PSDA(52.2551,PSREC_","_PSREJIEN_","_PSRXIEN_",",2)=$G(PSCOMNT)
88 . D FILE^DIE("","PSDA","PSERR")
89 Q
90 ;
91 ;/**
92 ;PSSFILE - subfile# (52.2551) for comment
93 ;PSIEN - ien for file in which the new subfile entry will be inserted
94 ;PSVAL01 - .01 value for the new entry
95INSITEM(PSSFILE,PSIEN0,PSIEN1,PSVAL01) ;*/
96 N PSSSI,PSIENS,PSFDA,PSER
97 S PSIENS="+1,"_PSIEN1_","_PSIEN0_","
98 S PSFDA(PSSFILE,PSIENS,.01)=PSVAL01
99 D UPDATE^DIE("","PSFDA","PSSSI","PSER")
100 I $D(PSER) D BMES^XPDUTL(PSER("DIERR",1,"TEXT",1))
101 Q
Note: See TracBrowser for help on using the repository browser.