source: WorldVistAEHR/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPREO24.m@ 846

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

initial load of WorldVistAEHR

File size: 3.4 KB
RevLine 
[613]1RMPREO24 ;HINES/ODJ ;suspense reports - Display all notes
2 ;;3.0;PROSTHETICS;**55**;Feb 09, 1996
3 ;
4 ; ODJ - patch 55 - implement a display of all notes posted to an
5 ; order in reverse chronological order
6 ; (nois MIN-0900-41546)
7 Q
8 ;
9 ; This subroutine implements patch 55 and is called from
10 ; VIEW^RMPREO23 which is called when a user selects the
11 ; View Request option [VR] on the Suspense Processing list
12 ; manager screen.
13 ;
14 ; Inputs
15 ; ------
16 ; RMPRIEN - ien of the order in ^RMPR(668
17 ;
18 ; Output
19 ; ------
20 ; RMPREXC - "^" if key press indicates return to menu
21 ;
22VALL(RMPRIEN,RMPREXC) ;
23 N RMPRS,RMPRA,RMPRROW,RMPRX,RMPRI,RMPRNTY,RMPRNDT,Y,RMPRDASH
24 N RMPRLL,RMPRSUB,RMPRWP,RMPRCL,RMPRMINL,RMPRUSRI,RMPRUSRC
25 S RMPREXC=""
26 W @IOF,"Chronological list of notes posted to the request...",!!
27 S RMPRCL=3
28 S $P(RMPRDASH,"-",81)=""
29 S RMPRMINL=5
30 ;
31 ; build an index RMPRX of notes by date and seq.
32 S RMPRS=^RMPR(668,RMPRIEN,0)
33 S RMPRNDT=$P(RMPRS,"^",9) ; Initial action date (type 3)
34 S RMPRUSRI=$$GETUSR(RMPRIEN,16) ; User entering Init Action
35 S RMPRX=1
36 S:RMPRNDT'="" RMPRX(RMPRNDT,RMPRX)=3,RMPRX=RMPRX+1
37 S RMPRNDT=$P(RMPRS,"^",5) ; Completion date (type 4)
38 S:RMPRNDT'="" RMPRX(RMPRNDT,RMPRX)=4,RMPRX=RMPRX+1
39 S RMPRUSRC=$$GETUSR(RMPRIEN,6) ; User entering Complete Action
40 ;
41 ; loop through all other notes (type 1)
42 S RMPRI=0
43 F S RMPRI=$O(^RMPR(668,RMPRIEN,1,RMPRI)) Q:'+RMPRI D
44 . S RMPRS=^RMPR(668,RMPRIEN,1,RMPRI,0)
45 . S RMPRNDT=$P(RMPRS,"^",1)
46 . S RMPRX(RMPRNDT,RMPRX)="1^"_RMPRI,RMPRX=RMPRX+1
47 . Q
48 ;
49 ; If haven't got any notes display message to inform user
50 ; and get any key press, then quit
51 I RMPRX=1 D G VALLX
52 . W "No notes have been posted to this request"
53 . K DIR S DIR(0)="E" D ^DIR K DIR S:Y'=1 RMPREXC="^"
54 . Q
55 ;
56 ; Now use index RMPRX built above to print out the notes
57 S RMPRA=""
58VALL1 S RMPRA=$O(RMPRX(RMPRA)) ;primary loop on note date
59 I RMPRA="" G VALLEND
60 S RMPRI=""
61VALL2 S RMPRI=$O(RMPRX(RMPRA,RMPRI)) ;loop on seq. within date
62 I RMPRI="" G VALL1 ;next note date
63 S RMPRS=RMPRX(RMPRA,RMPRI)
64 S RMPRNTY=$P(RMPRS,"^",1) ;get note type 1 Other, 3 Init Action
65 ; 4 Complete
66 S Y=RMPRA D DD^%DT S RMPRNDT=Y
67 ;
68 ; Print the note
69 I RMPRNTY=1 D
70 . S RMPRSUB=$P(RMPRS,"^",2) ;ien of sub-file
71 . S RMPRLL=$O(^RMPR(668,RMPRIEN,1,RMPRSUB,1,":"),-1)
72 . Q
73 E D
74 . S RMPRLL=$O(^RMPR(668,RMPRIEN,RMPRNTY,1,":"),-1)
75 . Q
76 I RMPRCL>3,(IOSL-(RMPRLL+RMPRCL))<RMPRMINL D G:RMPREXC="^" VALLX
77 . K DIR S DIR(0)="E" D ^DIR K DIR I Y'=1 S RMPREXC="^" Q
78 . S RMPRCL=1 W @IOF
79 . Q
80 W $S(RMPRNTY=3:"Initial Action Note",RMPRNTY=4:"Completion Note",1:"Other Action Note")," - ",RMPRNDT
81 W $S(RMPRNTY=3:" posted by "_RMPRUSRI,RMPRNTY=4:" posted by "_RMPRUSRC,1:""),!!
82 S RMPRCL=RMPRCL+2
83 I RMPRNTY=1 D
84 . S RMPRWP=0
85 . F S RMPRWP=$O(^RMPR(668,RMPRIEN,1,RMPRSUB,1,RMPRWP)) Q:'+RMPRWP D
86 .. W ^RMPR(668,RMPRIEN,1,RMPRSUB,1,RMPRWP,0),!
87 .. S RMPRCL=RMPRCL+1
88 .. Q
89 . Q
90 E D
91 . S RMPRWP=0
92 . F S RMPRWP=$O(^RMPR(668,RMPRIEN,RMPRNTY,RMPRWP)) Q:'+RMPRWP D
93 .. W ^RMPR(668,RMPRIEN,RMPRNTY,RMPRWP,0),!
94 .. S RMPRCL=RMPRCL+1
95 .. Q
96 . Q
97 W RMPRDASH,!
98 S RMPRCL=RMPRCL+1
99 G VALL2 ;next note seq.
100VALLEND I RMPRCL'=1 D
101 . K DIR S DIR(0)="E" D ^DIR K DIR S:Y'=1 RMPREXC="^"
102 . Q
103VALLX Q
104 ;
105 ; Get username from VA(200
106GETUSR(RMPRIEN,RMPRFLD) ;
107 N RMPROUP,RMPRIENS,RMPRUSR
108 S RMPRUSR=""
109 S RMPRIENS=RMPRIEN_","
110 D GETS^DIQ(668,RMPRIENS,RMPRFLD,"","RMPROUP",)
111 S:$D(RMPROUP) RMPRUSR=RMPROUP(668,RMPRIENS,RMPRFLD)
112 Q RMPRUSR
Note: See TracBrowser for help on using the repository browser.