- 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
