TIUPRF.m

TIUPRF ; SLC/JMH - API's for Patient Record Flags ; 7/29/05

 ;;1.0;TEXT INTEGRATION UTILITIES;**184**;Jun 20, 1997

 ;

ISPRFDOC(TIUDA) ;Function (called by PIMS) returns 1 if docmt is PRF,

 ;otherwise 0

 N TIUTTL

 S TIUTTL=+$G(^TIU(8925,TIUDA,0))

 I 'TIUTTL Q 0

 Q $$ISPFTTL^TIUPRFL(TIUTTL)

 ;

GETTTL(TIUDA) ; API called by PIMS to retrieve the name of a

 ;TIU Document

 ; Input   TIUDA: The TIU DOCUMENT TITLE IEN

 ; Output TIUTTL: The TIU DOCUMENT TITLE Name

 N TIUTTL,TIUNODE

 S TIUNODE=$G(^TIU(8925.1,TIUDA,0))

 I $G(TIUNODE)="" Q -1

 S TIUTTL=$P(TIUNODE,U,1)

 I $G(TIUTTL)="" Q -2

 Q TIUTTL

CHKDOC(TIUDA) ; API called by PIMS to check the existence of a TIU

 ;   Document before linking, deleting,...

 ; Input   TIUDA: The TIU DOCUMENT IEN

 ; Output TIURET: Return value 

 ;              (0 if Document does not exist, 1 if it does exist)

 N TIURET

 S TIURET=$D(^TIU(8925,TIUDA,0))

 I +TIURET S TIURET=1

 I 'TIURET S TIURET=0

 Q TIURET

 ;

GETLIST(PRFCAT,TARGET) ; API called by PIMS to retrieve a list of active

 ;   Category I and/or Category II Progress Note Titles

 ; Input  PRFCAT: PRF Category Flag [1,2 or 3]

 ;    1:Category I

 ;    2:Category II

 ;    3:Both Category I and II

 ; Input  TARGET: The array name to place the list of 

 ;                  Titles and IENs

 ; Output TIURET: Return value to pass back any error

 ;                  codes if necessary

 ;                 @TARGET@(CATEGORY,D0)=TITLE IEN^TITLE NAME

 ;                If nothing to return in list, TIUCNT=0 and TARGET array is empty

 N TIUCAT1,TIUCAT2,TIURET,TIUCNT,TIUNODE1,TIUNODE2,TIUDA

 S TIUCNT=0

 K @TARGET

 I '$D(PRFCAT)!('$D(TARGET)) Q "-1^MISSING INPUT"

 I PRFCAT=3!(PRFCAT=1) D

 . S TIUNODE1=0

 . S TIUCAT1=+$$DDEFIEN^TIUFLF7("PATIENT RECORD FLAG CAT I","DC")

 . F  S TIUNODE1=$O(^TIU(8925.1,TIUCAT1,10,TIUNODE1)) Q:'TIUNODE1  D

 . . S TIUDA=$P(^TIU(8925.1,TIUCAT1,10,TIUNODE1,0),U)

 . . I $P(^TIU(8925.1,TIUDA,0),U,7)=11!($P(^TIU(8925.1,TIUDA,0),U,7)=10) D

 . . . S TIUCNT=TIUCNT+1

 . . . S @TARGET@("CAT I",TIUCNT)=TIUDA_"^"_$$GETTTL(TIUDA)

 I PRFCAT=3!(PRFCAT=2) D

 . S TIUNODE2=0

 . S TIUCAT2=+$$DDEFIEN^TIUFLF7("PATIENT RECORD FLAG CAT II","DC")

 . F  S TIUNODE2=$O(^TIU(8925.1,TIUCAT2,10,TIUNODE2)) Q:'TIUNODE2  D

 . . S TIUDA=$P(^TIU(8925.1,TIUCAT2,10,TIUNODE2,0),U)

 . . I $P(^TIU(8925.1,TIUDA,0),U,7)=11!($P(^TIU(8925.1,TIUDA,0),U,7)=10) D

 . . . S TIUCNT=TIUCNT+1

 . . . S @TARGET@("CAT II",TIUCNT)=TIUDA_"^"_$$GETTTL(TIUDA)

 Q TIUCNT

TIUPRF    ; SLC/JMH - API's for Patient Record Flags ; 7/29/05

 +1       ;;1.0;TEXT INTEGRATION UTILITIES;**184**;Jun 20, 1997

 +2       ;

ISPRFDOC(TIUDA) ;Function (called by PIMS) returns 1 if docmt is PRF,

 +1       ;otherwise 0

 +2        NEW TIUTTL

 +3        SET TIUTTL=+$GET(^TIU(8925,TIUDA,0))

 +4        IF 'TIUTTL

               QUIT 0

 +5        QUIT $$ISPFTTL^TIUPRFL(TIUTTL)

 +6       ;

GETTTL(TIUDA) ; API called by PIMS to retrieve the name of a

 +1       ;TIU Document

 +2       ; Input   TIUDA: The TIU DOCUMENT TITLE IEN

 +3       ; Output TIUTTL: The TIU DOCUMENT TITLE Name

 +4        NEW TIUTTL,TIUNODE

 +5        SET TIUNODE=$GET(^TIU(8925.1,TIUDA,0))

 +6        IF $GET(TIUNODE)=""

               QUIT -1

 +7        SET TIUTTL=$PIECE(TIUNODE,U,1)

 +8        IF $GET(TIUTTL)=""

               QUIT -2

 +9        QUIT TIUTTL

CHKDOC(TIUDA) ; API called by PIMS to check the existence of a TIU

 +1       ;   Document before linking, deleting,...

 +2       ; Input   TIUDA: The TIU DOCUMENT IEN

 +3       ; Output TIURET: Return value 

 +4       ;              (0 if Document does not exist, 1 if it does exist)

 +5        NEW TIURET

 +6        SET TIURET=$DATA(^TIU(8925,TIUDA,0))

 +7        IF +TIURET

               SET TIURET=1

 +8        IF 'TIURET

               SET TIURET=0

 +9        QUIT TIURET

 +10      ;

GETLIST(PRFCAT,TARGET) ; API called by PIMS to retrieve a list of active

 +1       ;   Category I and/or Category II Progress Note Titles

 +2       ; Input  PRFCAT: PRF Category Flag [1,2 or 3]

 +3       ;    1:Category I

 +4       ;    2:Category II

 +5       ;    3:Both Category I and II

 +6       ; Input  TARGET: The array name to place the list of 

 +7       ;                  Titles and IENs

 +8       ; Output TIURET: Return value to pass back any error

 +9       ;                  codes if necessary

 +10      ;                 @TARGET@(CATEGORY,D0)=TITLE IEN^TITLE NAME

 +11      ;                If nothing to return in list, TIUCNT=0 and TARGET array is empty

 +12       NEW TIUCAT1,TIUCAT2,TIURET,TIUCNT,TIUNODE1,TIUNODE2,TIUDA

 +13       SET TIUCNT=0

 +14       KILL @TARGET

 +15       IF '$DATA(PRFCAT)!('$DATA(TARGET))

               QUIT "-1^MISSING INPUT"

 +16       IF PRFCAT=3!(PRFCAT=1)

               Begin DoDot:1

 +17               SET TIUNODE1=0

 +18               SET TIUCAT1=+$$DDEFIEN^TIUFLF7("PATIENT RECORD FLAG CAT I","DC")

 +19               FOR 

                       SET TIUNODE1=$ORDER(^TIU(8925.1,TIUCAT1,10,TIUNODE1))

                       IF 'TIUNODE1

                           QUIT 

                       Begin DoDot:2

 +20                       SET TIUDA=$PIECE(^TIU(8925.1,TIUCAT1,10,TIUNODE1,0),U)

 +21                       IF $PIECE(^TIU(8925.1,TIUDA,0),U,7)=11!($PIECE(^TIU(8925.1,TIUDA,0),U,7)=10)

                               Begin DoDot:3

 +22                               SET TIUCNT=TIUCNT+1

 +23                               SET @TARGET@("CAT I",TIUCNT)=TIUDA_"^"_$$GETTTL(TIUDA)

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +24       IF PRFCAT=3!(PRFCAT=2)

               Begin DoDot:1

 +25               SET TIUNODE2=0

 +26               SET TIUCAT2=+$$DDEFIEN^TIUFLF7("PATIENT RECORD FLAG CAT II","DC")

 +27               FOR 

                       SET TIUNODE2=$ORDER(^TIU(8925.1,TIUCAT2,10,TIUNODE2))

                       IF 'TIUNODE2

                           QUIT 

                       Begin DoDot:2

 +28                       SET TIUDA=$PIECE(^TIU(8925.1,TIUCAT2,10,TIUNODE2,0),U)

 +29                       IF $PIECE(^TIU(8925.1,TIUDA,0),U,7)=11!($PIECE(^TIU(8925.1,TIUDA,0),U,7)=10)

                               Begin DoDot:3

 +30                               SET TIUCNT=TIUCNT+1

 +31                               SET @TARGET@("CAT II",TIUCNT)=TIUDA_"^"_$$GETTTL(TIUDA)

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +32       QUIT TIUCNT