RMPREO24 ;HINES/ODJ ;suspense reports - Display all notes
;;3.0;PROSTHETICS;**55**;Feb 09, 1996
;
; ODJ - patch 55 - implement a display of all notes posted to an
; order in reverse chronological order
; (nois MIN-0900-41546)
Q
;
; This subroutine implements patch 55 and is called from
; VIEW^RMPREO23 which is called when a user selects the
; View Request option [VR] on the Suspense Processing list
; manager screen.
;
; Inputs
; ------
; RMPRIEN - ien of the order in ^RMPR(668
;
; Output
; ------
; RMPREXC - "^" if key press indicates return to menu
;
VALL(RMPRIEN,RMPREXC) ;
N RMPRS,RMPRA,RMPRROW,RMPRX,RMPRI,RMPRNTY,RMPRNDT,Y,RMPRDASH
N RMPRLL,RMPRSUB,RMPRWP,RMPRCL,RMPRMINL,RMPRUSRI,RMPRUSRC
S RMPREXC=""
W @IOF,"Chronological list of notes posted to the request...",!!
S RMPRCL=3
S $P(RMPRDASH,"-",81)=""
S RMPRMINL=5
;
; build an index RMPRX of notes by date and seq.
S RMPRS=^RMPR(668,RMPRIEN,0)
S RMPRNDT=$P(RMPRS,"^",9) ; Initial action date (type 3)
S RMPRUSRI=$$GETUSR(RMPRIEN,16) ; User entering Init Action
S RMPRX=1
S:RMPRNDT'="" RMPRX(RMPRNDT,RMPRX)=3,RMPRX=RMPRX+1
S RMPRNDT=$P(RMPRS,"^",5) ; Completion date (type 4)
S:RMPRNDT'="" RMPRX(RMPRNDT,RMPRX)=4,RMPRX=RMPRX+1
S RMPRUSRC=$$GETUSR(RMPRIEN,6) ; User entering Complete Action
;
; loop through all other notes (type 1)
S RMPRI=0
F S RMPRI=$O(^RMPR(668,RMPRIEN,1,RMPRI)) Q:'+RMPRI D
. S RMPRS=^RMPR(668,RMPRIEN,1,RMPRI,0)
. S RMPRNDT=$P(RMPRS,"^",1)
. S RMPRX(RMPRNDT,RMPRX)="1^"_RMPRI,RMPRX=RMPRX+1
. Q
;
; If haven't got any notes display message to inform user
; and get any key press, then quit
I RMPRX=1 D G VALLX
. W "No notes have been posted to this request"
. K DIR S DIR(0)="E" D ^DIR K DIR S:Y'=1 RMPREXC="^"
. Q
;
; Now use index RMPRX built above to print out the notes
S RMPRA=""
VALL1 S RMPRA=$O(RMPRX(RMPRA)) ;primary loop on note date
I RMPRA="" G VALLEND
S RMPRI=""
VALL2 S RMPRI=$O(RMPRX(RMPRA,RMPRI)) ;loop on seq. within date
I RMPRI="" G VALL1 ;next note date
S RMPRS=RMPRX(RMPRA,RMPRI)
S RMPRNTY=$P(RMPRS,"^",1) ;get note type 1 Other, 3 Init Action
; 4 Complete
S Y=RMPRA D DD^%DT S RMPRNDT=Y
;
; Print the note
I RMPRNTY=1 D
. S RMPRSUB=$P(RMPRS,"^",2) ;ien of sub-file
. S RMPRLL=$O(^RMPR(668,RMPRIEN,1,RMPRSUB,1,":"),-1)
. Q
E D
. S RMPRLL=$O(^RMPR(668,RMPRIEN,RMPRNTY,1,":"),-1)
. Q
I RMPRCL>3,(IOSL-(RMPRLL+RMPRCL))<RMPRMINL D G:RMPREXC="^" VALLX
. K DIR S DIR(0)="E" D ^DIR K DIR I Y'=1 S RMPREXC="^" Q
. S RMPRCL=1 W @IOF
. Q
W $S(RMPRNTY=3:"Initial Action Note",RMPRNTY=4:"Completion Note",1:"Other Action Note")," - ",RMPRNDT
W $S(RMPRNTY=3:" posted by "_RMPRUSRI,RMPRNTY=4:" posted by "_RMPRUSRC,1:""),!!
S RMPRCL=RMPRCL+2
I RMPRNTY=1 D
. S RMPRWP=0
. F S RMPRWP=$O(^RMPR(668,RMPRIEN,1,RMPRSUB,1,RMPRWP)) Q:'+RMPRWP D
.. W ^RMPR(668,RMPRIEN,1,RMPRSUB,1,RMPRWP,0),!
.. S RMPRCL=RMPRCL+1
.. Q
. Q
E D
. S RMPRWP=0
. F S RMPRWP=$O(^RMPR(668,RMPRIEN,RMPRNTY,RMPRWP)) Q:'+RMPRWP D
.. W ^RMPR(668,RMPRIEN,RMPRNTY,RMPRWP,0),!
.. S RMPRCL=RMPRCL+1
.. Q
. Q
W RMPRDASH,!
S RMPRCL=RMPRCL+1
G VALL2 ;next note seq.
VALLEND I RMPRCL'=1 D
. K DIR S DIR(0)="E" D ^DIR K DIR S:Y'=1 RMPREXC="^"
. Q
VALLX Q
;
; Get username from VA(200
GETUSR(RMPRIEN,RMPRFLD) ;
N RMPROUP,RMPRIENS,RMPRUSR
S RMPRUSR=""
S RMPRIENS=RMPRIEN_","
D GETS^DIQ(668,RMPRIENS,RMPRFLD,"","RMPROUP",)
S:$D(RMPROUP) RMPRUSR=RMPROUP(668,RMPRIENS,RMPRFLD)
Q RMPRUSR
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPREO24 3637 printed Apr 09, 2024@21:39:30 Page 2
RMPREO24 ;HINES/ODJ ;suspense reports - Display all notes
+1 ;;3.0;PROSTHETICS;**55**;Feb 09, 1996
+2 ;
+3 ; ODJ - patch 55 - implement a display of all notes posted to an
+4 ; order in reverse chronological order
+5 ; (nois MIN-0900-41546)
+6 QUIT
+7 ;
+8 ; This subroutine implements patch 55 and is called from
+9 ; VIEW^RMPREO23 which is called when a user selects the
+10 ; View Request option [VR] on the Suspense Processing list
+11 ; manager screen.
+12 ;
+13 ; Inputs
+14 ; ------
+15 ; RMPRIEN - ien of the order in ^RMPR(668
+16 ;
+17 ; Output
+18 ; ------
+19 ; RMPREXC - "^" if key press indicates return to menu
+20 ;
VALL(RMPRIEN,RMPREXC) ;
+1 NEW RMPRS,RMPRA,RMPRROW,RMPRX,RMPRI,RMPRNTY,RMPRNDT,Y,RMPRDASH
+2 NEW RMPRLL,RMPRSUB,RMPRWP,RMPRCL,RMPRMINL,RMPRUSRI,RMPRUSRC
+3 SET RMPREXC=""
+4 WRITE @IOF,"Chronological list of notes posted to the request...",!!
+5 SET RMPRCL=3
+6 SET $PIECE(RMPRDASH,"-",81)=""
+7 SET RMPRMINL=5
+8 ;
+9 ; build an index RMPRX of notes by date and seq.
+10 SET RMPRS=^RMPR(668,RMPRIEN,0)
+11 ; Initial action date (type 3)
SET RMPRNDT=$PIECE(RMPRS,"^",9)
+12 ; User entering Init Action
SET RMPRUSRI=$$GETUSR(RMPRIEN,16)
+13 SET RMPRX=1
+14 if RMPRNDT'=""
SET RMPRX(RMPRNDT,RMPRX)=3
SET RMPRX=RMPRX+1
+15 ; Completion date (type 4)
SET RMPRNDT=$PIECE(RMPRS,"^",5)
+16 if RMPRNDT'=""
SET RMPRX(RMPRNDT,RMPRX)=4
SET RMPRX=RMPRX+1
+17 ; User entering Complete Action
SET RMPRUSRC=$$GETUSR(RMPRIEN,6)
+18 ;
+19 ; loop through all other notes (type 1)
+20 SET RMPRI=0
+21 FOR
SET RMPRI=$ORDER(^RMPR(668,RMPRIEN,1,RMPRI))
if '+RMPRI
QUIT
Begin DoDot:1
+22 SET RMPRS=^RMPR(668,RMPRIEN,1,RMPRI,0)
+23 SET RMPRNDT=$PIECE(RMPRS,"^",1)
+24 SET RMPRX(RMPRNDT,RMPRX)="1^"_RMPRI
SET RMPRX=RMPRX+1
+25 QUIT
End DoDot:1
+26 ;
+27 ; If haven't got any notes display message to inform user
+28 ; and get any key press, then quit
+29 IF RMPRX=1
Begin DoDot:1
+30 WRITE "No notes have been posted to this request"
+31 KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
if Y'=1
SET RMPREXC="^"
+32 QUIT
End DoDot:1
GOTO VALLX
+33 ;
+34 ; Now use index RMPRX built above to print out the notes
+35 SET RMPRA=""
VALL1 ;primary loop on note date
SET RMPRA=$ORDER(RMPRX(RMPRA))
+1 IF RMPRA=""
GOTO VALLEND
+2 SET RMPRI=""
VALL2 ;loop on seq. within date
SET RMPRI=$ORDER(RMPRX(RMPRA,RMPRI))
+1 ;next note date
IF RMPRI=""
GOTO VALL1
+2 SET RMPRS=RMPRX(RMPRA,RMPRI)
+3 ;get note type 1 Other, 3 Init Action
SET RMPRNTY=$PIECE(RMPRS,"^",1)
+4 ; 4 Complete
+5 SET Y=RMPRA
DO DD^%DT
SET RMPRNDT=Y
+6 ;
+7 ; Print the note
+8 IF RMPRNTY=1
Begin DoDot:1
+9 ;ien of sub-file
SET RMPRSUB=$PIECE(RMPRS,"^",2)
+10 SET RMPRLL=$ORDER(^RMPR(668,RMPRIEN,1,RMPRSUB,1,":"),-1)
+11 QUIT
End DoDot:1
+12 IF '$TEST
Begin DoDot:1
+13 SET RMPRLL=$ORDER(^RMPR(668,RMPRIEN,RMPRNTY,1,":"),-1)
+14 QUIT
End DoDot:1
+15 IF RMPRCL>3
IF (IOSL-(RMPRLL+RMPRCL))<RMPRMINL
Begin DoDot:1
+16 KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
IF Y'=1
SET RMPREXC="^"
QUIT
+17 SET RMPRCL=1
WRITE @IOF
+18 QUIT
End DoDot:1
if RMPREXC="^"
GOTO VALLX
+19 WRITE $SELECT(RMPRNTY=3:"Initial Action Note",RMPRNTY=4:"Completion Note",1:"Other Action Note")," - ",RMPRNDT
+20 WRITE $SELECT(RMPRNTY=3:" posted by "_RMPRUSRI,RMPRNTY=4:" posted by "_RMPRUSRC,1:""),!!
+21 SET RMPRCL=RMPRCL+2
+22 IF RMPRNTY=1
Begin DoDot:1
+23 SET RMPRWP=0
+24 FOR
SET RMPRWP=$ORDER(^RMPR(668,RMPRIEN,1,RMPRSUB,1,RMPRWP))
if '+RMPRWP
QUIT
Begin DoDot:2
+25 WRITE ^RMPR(668,RMPRIEN,1,RMPRSUB,1,RMPRWP,0),!
+26 SET RMPRCL=RMPRCL+1
+27 QUIT
End DoDot:2
+28 QUIT
End DoDot:1
+29 IF '$TEST
Begin DoDot:1
+30 SET RMPRWP=0
+31 FOR
SET RMPRWP=$ORDER(^RMPR(668,RMPRIEN,RMPRNTY,RMPRWP))
if '+RMPRWP
QUIT
Begin DoDot:2
+32 WRITE ^RMPR(668,RMPRIEN,RMPRNTY,RMPRWP,0),!
+33 SET RMPRCL=RMPRCL+1
+34 QUIT
End DoDot:2
+35 QUIT
End DoDot:1
+36 WRITE RMPRDASH,!
+37 SET RMPRCL=RMPRCL+1
+38 ;next note seq.
GOTO VALL2
VALLEND IF RMPRCL'=1
Begin DoDot:1
+1 KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
if Y'=1
SET RMPREXC="^"
+2 QUIT
End DoDot:1
VALLX QUIT
+1 ;
+2 ; Get username from VA(200
GETUSR(RMPRIEN,RMPRFLD) ;
+1 NEW RMPROUP,RMPRIENS,RMPRUSR
+2 SET RMPRUSR=""
+3 SET RMPRIENS=RMPRIEN_","
+4 DO GETS^DIQ(668,RMPRIENS,RMPRFLD,"","RMPROUP",)
+5 if $DATA(RMPROUP)
SET RMPRUSR=RMPROUP(668,RMPRIENS,RMPRFLD)
+6 QUIT RMPRUSR
