AZAXFUNC.m

AZAXFUNC ;IHS/PHXAO/AEF - INSTALL AZAXHRN FUNCTION

 ;;1.0;ANNE'S SPECIAL ROUTINES;;AUG 19, 2004

 ;

DESC ;----- ROUTINE DESCRIPTION

 ;;

 ;;This routine installs the AZAXHRN function into the FUNCTION

 ;;file #.5.

 ;;

 ;;$$END

 ;

 N I,X

 F I=1:1 S X=$T(DESC+I) Q:X["$$END"  W !,$P(X,";;",2)

 Q

EN ;EP -- MAIN ENTRY POINT

 ;

 N Y

 ;

 D LOOKUP("AZAXHRN",.Y)

 I +Y>0 D  Q

 . W !,"LOOKS LIKE YOU ALREADY HAVE THE 'AZAXHRN' FUNCTION..."

 . W !,"NOTHING ADDED"

 ;

 D ADD("AZAXHRN")

 Q

LOOKUP(X,Y) ;

 ;

 N DIC

 ;

 S DIC="^DD(""FUNC"""_","

 S DIC(0)=""

 D ^DIC

 Q

ADD(X) ;

 ;----- ADD NEW ENTRY INTO FUNCTION FILE

 ;

 N DA,DATA,DD,DIC,DIE,DO,DR,I,Y

 ;

 S DIC="^DD(""FUNC"""_","

 S DIC(0)=""

 D FILE^DICN

 ;

 Q:+Y'>0

 ;

 S DA=+Y

 S DIE=DIC

 S DR=""

 F I=1:1 S DATA=$T(DATA+I) Q:DATA["$$END"  D

 . S DR=DR_";"_$P(DATA,";",3)_"////"_$P(DATA,";",5)

 I $E(DR)=";" S DR=$E(DR,2,$L(DR))

 ;

 D ^DIE

 ;

 W !,"'AZAXHRN' FUNCTION ADDED"

 Q

DATA ;----- FIELD DATA TO BE INSERTED

 ;;.02;MUMPS CODE;N ZZZ S X="" S ZZZ=$O(I(99999),-1),ZZZ=$G(I(ZZZ)) I "^DPT(^AUPNPAT("[ZZZ S X=$P($G(^AUPNPAT($G(D0),41,+$G(DUZ(2)),0)),U,2)

 ;;1;EXPLANATION;Gets patient's HRN of signed onto facility.  Must use from VA PATIENT or PATIENT file.

 ;;9;NUMBER OF ARGUMENTS;0

 ;;$$END

AZAXFUNC  ;IHS/PHXAO/AEF - INSTALL AZAXHRN FUNCTION

 +1       ;;1.0;ANNE'S SPECIAL ROUTINES;;AUG 19, 2004

 +2       ;

DESC      ;----- ROUTINE DESCRIPTION

 +1       ;;

 +2       ;;This routine installs the AZAXHRN function into the FUNCTION

 +3       ;;file #.5.

 +4       ;;

 +5       ;;$$END

 +6       ;

 +7        NEW I,X

 +8        FOR I=1:1

               SET X=$TEXT(DESC+I)

               IF X["$$END"

                   QUIT 

               WRITE !,$PIECE(X,";;",2)

 +9        QUIT 

EN        ;EP -- MAIN ENTRY POINT

 +1       ;

 +2        NEW Y

 +3       ;

 +4        DO LOOKUP("AZAXHRN",.Y)

 +5        IF +Y>0

               Begin DoDot:1

 +6                WRITE !,"LOOKS LIKE YOU ALREADY HAVE THE 'AZAXHRN' FUNCTION..."

 +7                WRITE !,"NOTHING ADDED"

               End DoDot:1

               QUIT 

 +8       ;

 +9        DO ADD("AZAXHRN")

 +10       QUIT 

LOOKUP(X,Y) ;

 +1       ;

 +2        NEW DIC

 +3       ;

 +4        SET DIC="^DD(""FUNC"""_","

 +5        SET DIC(0)=""

 +6        DO ^DIC

 +7        QUIT 

ADD(X)    ;

 +1       ;----- ADD NEW ENTRY INTO FUNCTION FILE

 +2       ;

 +3        NEW DA,DATA,DD,DIC,DIE,DO,DR,I,Y

 +4       ;

 +5        SET DIC="^DD(""FUNC"""_","

 +6        SET DIC(0)=""

 +7        DO FILE^DICN

 +8       ;

 +9        IF +Y'>0

               QUIT 

 +10      ;

 +11       SET DA=+Y

 +12       SET DIE=DIC

 +13       SET DR=""

 +14       FOR I=1:1

               SET DATA=$TEXT(DATA+I)

               IF DATA["$$END"

                   QUIT 

               Begin DoDot:1

 +15               SET DR=DR_";"_$PIECE(DATA,";",3)_"////"_$PIECE(DATA,";",5)

               End DoDot:1

 +16       IF $EXTRACT(DR)=";"

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

 +17      ;

 +18       DO ^DIE

 +19      ;

 +20       WRITE !,"'AZAXHRN' FUNCTION ADDED"

 +21       QUIT 

DATA      ;----- FIELD DATA TO BE INSERTED

 +1       ;;.02;MUMPS CODE;N ZZZ S X="" S ZZZ=$O(I(99999),-1),ZZZ=$G(I(ZZZ)) I "^DPT(^AUPNPAT("[ZZZ S X=$P($G(^AUPNPAT($G(D0),41,+$G(DUZ(2)),0)),U,2)

 +2       ;;1;EXPLANATION;Gets patient's HRN of signed onto facility.  Must use from VA PATIENT or PATIENT file.

 +3       ;;9;NUMBER OF ARGUMENTS;0

 +4       ;;$$END