ABSVU1.m

ABSVU1 ;VAMC ALTOONA/CTB - MISC UTILITY PROGRAMS ;2/10/00  2:31 PM

V ;;4.0;VOLUNTARY TIMEKEEPING;**7,10,15,18**;JULY 6, 1994

GET(A,B,C,D) ;function to insert variables C and D into phrase A in language B.

 N X,ONE,TWO

 S B=$S($G(B)>0:B,1:1),ONE="|1|",TWO="|2|"

 S X=$$PHRASE(A,B)

 I $D(C),X[ONE S X=$P(X,ONE,1)_C_$P(X,ONE,2,99)

 I $D(D),X[TWO S X=$P(X,TWO,1)_D_$P(X,TWO,2,99)

 QUIT X

PHRASE(F,G) ;

 N H

 I F Q $G(^ABS(503339,F,G))

 S H=$O(^ABS(503339,"C",$E(F,1,30),0)) I 'H Q "INVALID PHRASE - CONTACT PROGRAMMER - "_F

 Q $G(^ABS(503339,H,G))

BDATE(AA) ;FUNCTION TO DETERMINE IF DATE IS LESS THAN 5 YEARS IN THE PAST

 ;RETURNS 0 IF < 5 YEARS OR 1 IF GREATER

 ;REQUIRES DT

 N X,Y,Z,%,ABSVXA,ABSVXB

 Q:'$D(ABSV("SITE")) 1

 S X=DT-50000

 Q:(AA<X) 1

 W ! S ABSVXA="Are you sure about this date",ABSVXB="",%=2 D ^ABSVYN

 Q:(%=1) 1

 Q 0

STRIP(X) ;FUNCTION TO STRIP LEADING BLANKS FROM STRING

 F  S:$E(X)=" " X=$E(X,2,$L(X)) Q:$E(X)'=" "

 Q X

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---ABSVU1   964     printed  Apr 07, 2021@15:44:35                                                                                                                                                                                                       Page 2

ABSVU1    ;VAMC ALTOONA/CTB - MISC UTILITY PROGRAMS ;2/10/00  2:31 PM

V         ;;4.0;VOLUNTARY TIMEKEEPING;**7,10,15,18**;JULY 6, 1994

GET(A,B,C,D) ;function to insert variables C and D into phrase A in language B.

 +1        NEW X,ONE,TWO

 +2        SET B=$SELECT($GET(B)>0:B,1:1)

           SET ONE="|1|"

           SET TWO="|2|"

 +3        SET X=$$PHRASE(A,B)

 +4        IF $DATA(C)

               IF X[ONE

                   SET X=$PIECE(X,ONE,1)_C_$PIECE(X,ONE,2,99)

 +5        IF $DATA(D)

               IF X[TWO

                   SET X=$PIECE(X,TWO,1)_D_$PIECE(X,TWO,2,99)

 +6        QUIT X

PHRASE(F,G) ;

 +1        NEW H

 +2        IF F

               QUIT $GET(^ABS(503339,F,G))

 +3        SET H=$ORDER(^ABS(503339,"C",$EXTRACT(F,1,30),0))

           IF 'H

               QUIT "INVALID PHRASE - CONTACT PROGRAMMER - "_F

 +4        QUIT $GET(^ABS(503339,H,G))

BDATE(AA) ;FUNCTION TO DETERMINE IF DATE IS LESS THAN 5 YEARS IN THE PAST

 +1       ;RETURNS 0 IF < 5 YEARS OR 1 IF GREATER

 +2       ;REQUIRES DT

 +3        NEW X,Y,Z,%,ABSVXA,ABSVXB

 +4        if '$DATA(ABSV("SITE"))

               QUIT 1

 +5        SET X=DT-50000

 +6        if (AA<X)

               QUIT 1

 +7        WRITE !

           SET ABSVXA="Are you sure about this date"

           SET ABSVXB=""

           SET %=2

           DO ^ABSVYN

 +8        if (%=1)

               QUIT 1

 +9        QUIT 0

STRIP(X)  ;FUNCTION TO STRIP LEADING BLANKS FROM STRING

 +1        FOR 

               if $EXTRACT(X)=" "

                   SET X=$EXTRACT(X,2,$LENGTH(X))

               if $EXTRACT(X)'=" "

                   QUIT 

 +2        QUIT X