BKMVUTL.m

BKMVUTL ;PRXM/HC/ALA - HMS UTILITIES ; 21 Sep 2005  6:38 PM

 ;;2.1;HIV MANAGEMENT SYSTEM;;Feb 07, 2011

 ;

SRC ;  State Reporting Category Prompt

 K DIR

 NEW Y,X

 S SRCAT=""

 S DIR(0)="SO^H:HIV;A:AIDS"

 D ^DIR K DIR

 I Y="^"!(Y="") Q

 S SRCAT=Y

 Q

 ;

PROB(PIEN) ; EP - Return date/time from Problem

 ;  Input Parameter

 ;    PIEN = IEN of problem

 ;

 NEW VISDTM

 S VISDTM=$$GET1^DIQ(9000011,PIEN,.08,"I")

 I VISDTM="" S VISDTM=$$GET1^DIQ(9000011,PIEN,.03,"I")

 Q VISDTM

 ;

STC(FIL,FLD,VAL) ; EP - Find a value for a set of codes code

 ;  Input Parameters

 ;    FIL = FileMan File Number

 ;    FLD = FileMan Field Number

 ;    VAL = Code Value

 ;

 NEW VEDATA,VEQFL,VEVL,VALUE

 S VEDATA=$P(^DD(FIL,FLD,0),U,3),VEQFL=0

 ;

 F I=1:1 S VEVL=$P(VEDATA,";",I) Q:VEVL=""  D  Q:VEQFL

 . S VALUE=$P(VEVL,":",2) I VAL=$P(VEVL,":",1) S VEQFL=1

 ;

 Q VALUE

 ;

HRN(BKMVDFN) ;EP - Find any active HRNs for a patient

 NEW HRN,FLAG,SITE

 S FLAG=0,SITE=0

 F  S SITE=$O(^AUPNPAT(BKMVDFN,41,SITE)) Q:'SITE  D  Q:FLAG

 . I $P($G(^AUPNPAT(BKMVDFN,41,SITE,0)),U,3)="" S FLAG=1

 Q FLAG

BKMVUTL   ;PRXM/HC/ALA - HMS UTILITIES ; 21 Sep 2005  6:38 PM

 +1       ;;2.1;HIV MANAGEMENT SYSTEM;;Feb 07, 2011

 +2       ;

SRC       ;  State Reporting Category Prompt

 +1        KILL DIR

 +2        NEW Y,X

 +3        SET SRCAT=""

 +4        SET DIR(0)="SO^H:HIV;A:AIDS"

 +5        DO ^DIR

           KILL DIR

 +6        IF Y="^"!(Y="")

               QUIT 

 +7        SET SRCAT=Y

 +8        QUIT 

 +9       ;

PROB(PIEN) ; EP - Return date/time from Problem

 +1       ;  Input Parameter

 +2       ;    PIEN = IEN of problem

 +3       ;

 +4        NEW VISDTM

 +5        SET VISDTM=$$GET1^DIQ(9000011,PIEN,.08,"I")

 +6        IF VISDTM=""

               SET VISDTM=$$GET1^DIQ(9000011,PIEN,.03,"I")

 +7        QUIT VISDTM

 +8       ;

STC(FIL,FLD,VAL) ; EP - Find a value for a set of codes code

 +1       ;  Input Parameters

 +2       ;    FIL = FileMan File Number

 +3       ;    FLD = FileMan Field Number

 +4       ;    VAL = Code Value

 +5       ;

 +6        NEW VEDATA,VEQFL,VEVL,VALUE

 +7        SET VEDATA=$PIECE(^DD(FIL,FLD,0),U,3)

           SET VEQFL=0

 +8       ;

 +9        FOR I=1:1

               SET VEVL=$PIECE(VEDATA,";",I)

               IF VEVL=""

                   QUIT 

               Begin DoDot:1

 +10               SET VALUE=$PIECE(VEVL,":",2)

                   IF VAL=$PIECE(VEVL,":",1)

                       SET VEQFL=1

               End DoDot:1

               IF VEQFL

                   QUIT 

 +11      ;

 +12       QUIT VALUE

 +13      ;

HRN(BKMVDFN) ;EP - Find any active HRNs for a patient

 +1        NEW HRN,FLAG,SITE

 +2        SET FLAG=0

           SET SITE=0

 +3        FOR 

               SET SITE=$ORDER(^AUPNPAT(BKMVDFN,41,SITE))

               IF 'SITE

                   QUIT 

               Begin DoDot:1

 +4                IF $PIECE($GET(^AUPNPAT(BKMVDFN,41,SITE,0)),U,3)=""

                       SET FLAG=1

               End DoDot:1

               IF FLAG

                   QUIT 

 +5        QUIT FLAG