BTPWTIUU ;VNGT/HS/BEE-CMET TIU UTILITIES ; 24 Aug 2009 6:50 PM
;;1.0;CARE MANAGEMENT EVENT TRACKING;;Feb 07, 2011
;
TITLE(DATA,FAKE) ; EP - BTPW GET TIU TITLES
; Input
; BTPWDFN = Patient IEN
;
NEW UID,I,II,LIST,NLIST,TENTRY,TIEN,TITLE,CAT,SI,LI
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BTPWTIUU",UID))
K @DATA
I $G(DT)=""!($G(U)="") D DT^DICRW
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BTPWTIUU D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
;Header
S II=II+1,@DATA@(II)="I00010TIEN^T00050TITLE"_$C(30)
;
;Pull list of entries
D LIST^TIUSRVD(.LIST,3)
S I="" F S I=$O(LIST(I)) Q:I="" S:LIST(I)["~SHORT" SI=I S:LIST(I)["~LONG" LI=I
;
;Loop through, pull long list entries, sort, and format
S I=""
F S I=$O(LIST(I)) Q:I="" D
.S TENTRY=$G(LIST(I)) Q:$E(TENTRY,1)'="i"
.I I<LI S CAT="S"
.I I>LI S CAT="L"
.S TIEN=$E($P(TENTRY,U),2,99) Q:TIEN'>0
.;
.;Get NAME (RPC returns PRINT NAME
.;S TITLE=$$GET1^DIQ(8925.1,TIEN_",",".01","E") Q:TITLE=""
.S TITLE=$P(LIST(I),U,2)
.I $$UP^XLFSTR(TITLE)="ADDENDUM" Q
.I CAT="L",$D(NLIST("S",TITLE,TIEN)) Q
.S NLIST(CAT,TITLE,TIEN)=""
;
;Output
S CAT=""
F S CAT=$O(NLIST(CAT),-1) Q:CAT="" D
. S TITLE=""
. F S TITLE=$O(NLIST(CAT,TITLE)) Q:TITLE="" D
.. S TIEN="" F S TIEN=$O(NLIST(CAT,TITLE,TIEN)) Q:TIEN="" D
... S II=II+1,@DATA@(II)=TIEN_U_TITLE_$C(30)
. D UP
;
DONE ;
S II=II+1,@DATA@(II)=$C(31)
Q
;
ERR ;
D ^%ZTER
NEW Y,ERRDTM
S Y=$$NOW^XLFDT() X ^DD("DD") S ERRDTM=Y
S BMXSEC="Recording that an error occurred at "_ERRDTM
S II=II+1,@DATA@(II)=$C(31)
Q
;
UP ;
S II=II+1,@DATA@(II)=" "_$C(30)
Q
BTPWTIUU ;VNGT/HS/BEE-CMET TIU UTILITIES ; 24 Aug 2009 6:50 PM
+1 ;;1.0;CARE MANAGEMENT EVENT TRACKING;;Feb 07, 2011
+2 ;
TITLE(DATA,FAKE) ; EP - BTPW GET TIU TITLES
+1 ; Input
+2 ; BTPWDFN = Patient IEN
+3 ;
+4 NEW UID,I,II,LIST,NLIST,TENTRY,TIEN,TITLE,CAT,SI,LI
+5 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+6 SET DATA=$NAME(^TMP("BTPWTIUU",UID))
+7 KILL @DATA
+8 IF $GET(DT)=""!($GET(U)="")
DO DT^DICRW
+9 ;
+10 SET II=0
+11 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BTPWTIUU D UNWIND^%ZTER"
+12 ;
+13 ;Header
+14 SET II=II+1
SET @DATA@(II)="I00010TIEN^T00050TITLE"_$CHAR(30)
+15 ;
+16 ;Pull list of entries
+17 DO LIST^TIUSRVD(.LIST,3)
+18 SET I=""
FOR
SET I=$ORDER(LIST(I))
IF I=""
QUIT
IF LIST(I)["~SHORT"
SET SI=I
IF LIST(I)["~LONG"
SET LI=I
+19 ;
+20 ;Loop through, pull long list entries, sort, and format
+21 SET I=""
+22 FOR
SET I=$ORDER(LIST(I))
IF I=""
QUIT
Begin DoDot:1
+23 SET TENTRY=$GET(LIST(I))
IF $EXTRACT(TENTRY,1)'="i"
QUIT
+24 IF I<LI
SET CAT="S"
+25 IF I>LI
SET CAT="L"
+26 SET TIEN=$EXTRACT($PIECE(TENTRY,U),2,99)
IF TIEN'>0
QUIT
+27 ;
+28 ;Get NAME (RPC returns PRINT NAME
+29 ;S TITLE=$$GET1^DIQ(8925.1,TIEN_",",".01","E") Q:TITLE=""
+30 SET TITLE=$PIECE(LIST(I),U,2)
+31 IF $$UP^XLFSTR(TITLE)="ADDENDUM"
QUIT
+32 IF CAT="L"
IF $DATA(NLIST("S",TITLE,TIEN))
QUIT
+33 SET NLIST(CAT,TITLE,TIEN)=""
End DoDot:1
+34 ;
+35 ;Output
+36 SET CAT=""
+37 FOR
SET CAT=$ORDER(NLIST(CAT),-1)
IF CAT=""
QUIT
Begin DoDot:1
+38 SET TITLE=""
+39 FOR
SET TITLE=$ORDER(NLIST(CAT,TITLE))
IF TITLE=""
QUIT
Begin DoDot:2
+40 SET TIEN=""
FOR
SET TIEN=$ORDER(NLIST(CAT,TITLE,TIEN))
IF TIEN=""
QUIT
Begin DoDot:3
+41 SET II=II+1
SET @DATA@(II)=TIEN_U_TITLE_$CHAR(30)
End DoDot:3
End DoDot:2
+42 DO UP
End DoDot:1
+43 ;
DONE ;
+1 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+2 QUIT
+3 ;
ERR ;
+1 DO ^%ZTER
+2 NEW Y,ERRDTM
+3 SET Y=$$NOW^XLFDT()
XECUTE ^DD("DD")
SET ERRDTM=Y
+4 SET BMXSEC="Recording that an error occurred at "_ERRDTM
+5 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+6 QUIT
+7 ;
UP ;
+1 SET II=II+1
SET @DATA@(II)=" "_$CHAR(30)
+2 QUIT
