| [613] | 1 | TIUPRD ; SLC/JER - Single patient print ;5/19/04
|
|---|
| 2 | ;;1.0;TEXT INTEGRATION UTILITIES;**1,100,121,182**;Jun 20, 1997
|
|---|
| 3 | ;
|
|---|
| 4 | REPLACE(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
|
|---|
| 51 | REPX Q
|
|---|
| 52 | ;
|
|---|
| 53 | MAIN(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
|
|---|
| 65 | PRINTX D ^%ZISC
|
|---|
| 66 | K ^TMP("TIUPR",$J)
|
|---|
| 67 | Q
|
|---|
| 68 | PRINTN ; 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
|
|---|
