source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUPRD.m@ 839

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

initial load of WorldVistAEHR

File size: 4.3 KB
Line 
1TIUPRD ; SLC/JER - Single patient print ;5/19/04
2 ;;1.0;TEXT INTEGRATION UTILITIES;**1,100,121,182**;Jun 20, 1997
3 ;
4REPLACE(TIUDA) ; Populate TMP array w records received,
5 ;replacing ID kids w ID parents; replacing addenda with their parents
6 ;or grandparents.
7 ; Requires TIUDA.
8 ; Sets ^TMP("TIUREPLACE",$J,IFN)=1 or 1^TIUDA, or 0
9 ;where IFN is TIUDA or parent or grandparent of TIUDA.
10 ; If TIUDA is replaced, then ^TMP("TIUREPLACE",$J,IFN)=1^TIUDA,
11 ;to know what child the parent was included in the list for.
12 ; Sets & passes back ^TMP("TIUREPLACE",$J) = # of elements in array.
13 N IDPRNT,ADDPRNT,ADDGPNT
14 S ^TMP("TIUREPLACE",$J)=+$G(^TMP("TIUREPLACE",$J))
15 S IDPRNT=+$G(^TIU(8925,TIUDA,21)) ; ID parent
16 ; -- If kid has parent that doesn't exist,
17 ; treat kid as stand-alone:
18 I '$D(^TIU(8925,IDPRNT,0)) S IDPRNT=0
19 S ADDPRNT=$P(^TIU(8925,TIUDA,0),U,6)
20 I ADDPRNT,'$D(^TIU(8925,ADDPRNT,0)) Q
21 I ADDPRNT S ADDGPNT=+$G(^TIU(8925,ADDPRNT,21))
22 I $G(ADDGPNT),'$D(^TIU(8925,ADDGPNT,0)) S ADDGPNT=0
23 ;============================================
24 ; -- If TIUDA is not an ID kid & not addm, just put it
25 ; in array and quit: --
26 I 'IDPRNT,'ADDPRNT D G REPX
27 . ; -- If TIUDA is already in array (as parent/gpa of previous kid),
28 . ; and is now received on its own merit, forget the original
29 . ; child. If not already in array, put it in. Quit.
30 . I $D(^TMP("TIUREPLACE",$J,TIUDA)) S $P(^TMP("TIUREPLACE",$J,TIUDA),U,2)="" Q
31 . S ^TMP("TIUREPLACE",$J,TIUDA)=1
32 . S ^TMP("TIUREPLACE",$J)=$G(^TMP("TIUREPLACE",$J))+1
33 ; ==========================================
34 ; -- If TIUDA is an ID kid, put its parent in array and track
35 ; original child:
36 I IDPRNT D G REPX
37 . S ^TMP("TIUREPLACE",$J,IDPRNT)=1_U_TIUDA
38 . S ^TMP("TIUREPLACE",$J)=$G(^TMP("TIUREPLACE",$J))+1
39 ; ===========================================
40 ; -- If TIUDA is an addm to standalone note, put parent in
41 ; array and track orig addm:
42 I ADDPRNT,'ADDGPNT D G REPX
43 . S ^TMP("TIUREPLACE",$J,ADDPRNT)=1_U_TIUDA
44 . S ^TMP("TIUREPLACE",$J)=$G(^TMP("TIUREPLACE",$J))+1
45 ; ===========================================
46 ; -- If TIUDA is an addm to ID kid, put ID parent in
47 ; array and track orig addm:
48 I ADDPRNT,ADDGPNT D G REPX
49 . S ^TMP("TIUREPLACE",$J,ADDGPNT)=1_U_TIUDA
50 . S ^TMP("TIUREPLACE",$J)=$G(^TMP("TIUREPLACE",$J))+1
51REPX Q
52 ;
53MAIN(TIUTYP) ; Control Branching
54 N DFN,TIU,TIUOUT,TIUREL,TIUCHK,TIUA,TIUSEE,ACT,TIUY,TIUFLAG
55 N TIUDAT,TIUOUT,TIUSEE,TIUI,TIUQUIT,TIUDEV
56 I '$D(TIUPRM0) D SETPARM^TIULE
57 S:$D(ORVP) DFN=+ORVP S TIUTYP=$G(TIUTYP,38)
58 D SELPAT^TIULA2(.TIUDAT,TIUTYP,+$G(DFN))
59 I +$G(TIUDAT)'>0,($D(TIUDAT)'>9) S TIUOUT=1 Q
60 S TIUFLAG=$$FLAG^TIUPRPN3
61 S TIUDEV=$$DEVICE^TIUDEV(.IO) ; Get Device/allow queueing
62 I IO']"" G PRINTX
63 I $D(IO("Q")) D QUE^TIUDEV("PRINTN^TIUPRD",TIUDEV) G PRINTX
64 D PRINTN
65PRINTX D ^%ZISC
66 K ^TMP("TIUPR",$J)
67 Q
68PRINTN ; Loop through selected doc's & invoke print code as appropriate
69 N TIUI,TIUTYP,TIUDARR,DFN,TIULNO,DIROUT
70 K ^TMP("TIUREPLACE",$J)
71 U IO
72 S TIUI=0
73 F S TIUI=$O(TIUDAT(TIUI)) Q:+TIUI'>0 D Q:$D(DIROUT)
74 . N TIUPGRP,TIUPMTHD,TIUPFHDR,TIUPFNBR,ORIGCHLD
75 . S TIUDA=+$G(TIUDAT(TIUI))
76 . I '+$G(^TIU(8925,+TIUDA,0)) Q
77 . ; -- Set ^TMP("TIUREPLACE",$J),
78 . ; with ID kids & adda replaced by parents:
79 . D REPLACE(TIUDA)
80 . S TIULNO(TIUDA)=TIUI
81 ; -- Set TIUDARR w info needed to print TIUDA:
82 S TIUDA=0 F S TIUDA=$O(^TMP("TIUREPLACE",$J,TIUDA)) Q:'TIUDA D
83 . S TIUTYP=$P(^TIU(8925,TIUDA,0),U),DFN=$P(^(0),U,2)
84 . I +TIUTYP D
85 . . S TIUPMTHD=$$PRNTMTHD^TIULG(+TIUTYP)
86 . . S TIUPGRP=$$PRNTGRP^TIULG(+TIUTYP)
87 . . S TIUPFHDR=$$PRNTHDR^TIULG(+TIUTYP)
88 . . S TIUPFNBR=$$PRNTNBR^TIULG(+TIUTYP)
89 . Q:$G(TIUPMTHD)']""
90 . S TIUI=$G(TIULNO(TIUDA))
91 . I '$G(TIUI) D
92 . . S ORIGCHLD=$P(^TMP("TIUREPLACE",$J,TIUDA),U,2),TIUI=$G(TIULNO(ORIGCHLD))
93 . ;I +$G(TIUPGRP),($G(TIUPFHDR)]""),($G(TIUPFNBR)]"") S TIUDARR(TIUPMTHD,$G(TIUPGRP)_"$"_TIUPFHDR_";"_DFN,TIUI,TIUDA)=TIUPFNBR
94 . ;E S TIUDARR(TIUPMTHD,DFN,TIUI,TIUDA)=""
95 . ; -- P182: Set array same whether or not flds are defined, with
96 . ; TIUPGRP piece possibly 0, TIUPFHDR piece possibly null, and
97 . ; array value TIUPFNBR possibly null.
98 . S TIUDARR(TIUPMTHD,+$G(TIUPGRP)_"$"_$G(TIUPFHDR)_";"_DFN,TIUI,TIUDA)=$G(TIUPFNBR)
99 K ^TMP("TIUREPLACE",$J)
100 ; -- Sort printout by printmethod (prints similar docmts together):
101 S TIUPMTHD="" F S TIUPMTHD=$O(TIUDARR(TIUPMTHD)) Q:TIUPMTHD="" D
102 . D PRNTDOC^TIURA(TIUPMTHD,.TIUDARR)
103 Q
Note: See TracBrowser for help on using the repository browser.