XUSNPIUT.m

XUSNPIUT ;JLI/FO-OAK - UNIT TEST ROUTINE FOR NPI WORK ;5/12/06  08:54

 ;;8.0;KERNEL;**420**;Jul 10, 1995;Build 20

 I $T(EN^XTMUNIT)'="" D EN^XTMUNIT("XUSNPIUT")

 Q

 ;

ALIGNRGT ;

 D CHKEQ^XTMUNIT($$ALIGNRGT^XUSNPIED("TEXT1",10),"     TEXT1","INCORRECT RETURN VALUE")

 D CHKEQ^XTMUNIT($$ALIGNRGT^XUSNPIED("AA AA",6)," AA AA","INCORRECT RETURN VALUE")

 Q

 ;

NEEDSNPI ;

 N OLDVALUE,NEWVALUE,XUFDA,IENS

 S IENS=DUZ_","

 S OLDVALUE=$$GET1^DIQ(200,IENS,41.98)

 K XUFDA S XUFDA(200,IENS,41.98)="@" D FILE^DIE("","XUFDA")

 D CHKEQ^XTMUNIT($$NEEDSNPI^XUSNPIED(DUZ),0,"INCORRECT OR NO DATA")

 ;

 K XUFDA S XUFDA(200,IENS,41.98)="N" D FILE^DIE("","XUFDA")

 D CHKEQ^XTMUNIT($$NEEDSNPI^XUSNPIED(DUZ),1,"INCORRECT ON NEEDS")

 ;

 K XUFDA S XUFDA(200,IENS,41.98)="E" D FILE^DIE("","XUFDA")

 D CHKEQ^XTMUNIT($$NEEDSNPI^XUSNPIED(DUZ),0,"INCORRECT ON EXEMPT")

 ;

 K XUFDA S XUFDA(200,IENS,41.98)="D" D FILE^DIE("","XUFDA")

 D CHKEQ^XTMUNIT($$NEEDSNPI^XUSNPIED(DUZ),0,"INCORRECT ON DONE")

 ;

 K XUFDA S XUFDA(200,IENS,41.98)=$S(OLDVALUE'="":OLDVALUE,1:"@")

 Q

 ;

HASNPI ;

 N OLDVALUE,NEWVALUE,XUFDA,IENS

 S IENS=DUZ_","

 S OLDVALUE=$$GET1^DIQ(200,IENS,41.98)

 K XUFDA S XUFDA(200,IENS,41.98)="@" D FILE^DIE("","XUFDA")

 D CHKEQ^XTMUNIT($$HASNPI^XUSNPIED(DUZ),0,"INCORRECT ON NO DATA")

 ;

 K XUFDA S XUFDA(200,IENS,41.98)="N" D FILE^DIE("","XUFDA")

 D CHKEQ^XTMUNIT($$HASNPI^XUSNPIED(DUZ),0,"INCORRECT ON NEEDS")

 ;

 K XUFDA S XUFDA(200,IENS,41.98)="E" D FILE^DIE("","XUFDA")

 D CHKEQ^XTMUNIT($$HASNPI^XUSNPIED(DUZ),0,"INCORRECT ON EXEMPT")

 ;

 K XUFDA S XUFDA(200,IENS,41.98)="D" D FILE^DIE("","XUFDA")

 D CHKEQ^XTMUNIT($$HASNPI^XUSNPIED(DUZ),1,"INCORRECT ON DONE")

 ;

 K XUFDA S XUFDA(200,IENS,41.98)=$S(OLDVALUE'="":$E(OLDVALUE),1:"@")

 Q

 ;

GETNPI ;

 N I,VALUE

 F I=0:0 S I=$O(^VA(200,I)) Q:I'>0  I $G(^VA(200,I,"NPI"))'="" Q

 I I'>0 D FAIL^XTMUNIT("NO VALID DATA AVAILABLE") Q

 S VALUE=$$GET1^DIQ(200,I_",",41.99)

 D CHKEQ^XTMUNIT($$GETNPI^XUSNPIED(I),VALUE,"INCORRECT VALUE RETURNED")

 Q

 ;

NPISTATS ;

 N OLDVALUE,NEWVALUE,XUFDA,IENS

 S IENS=DUZ_","

 S OLDVALUE=$$GET1^DIQ(200,IENS,41.98)

 K XUFDA S XUFDA(200,IENS,41.98)="@" D FILE^DIE("","XUFDA")

 D CHKEQ^XTMUNIT($$NPISTATS^XUSNPIED(DUZ),"","INCORRECT ON NO DATA")

 ;

 K XUFDA S XUFDA(200,IENS,41.98)="N" D FILE^DIE("","XUFDA")

 D CHKEQ^XTMUNIT($$NPISTATS^XUSNPIED(DUZ),"N","INCORRECT ON NEEDS")

 ;

 K XUFDA S XUFDA(200,IENS,41.98)="E" D FILE^DIE("","XUFDA")

 D CHKEQ^XTMUNIT($$NPISTATS^XUSNPIED(DUZ),"E","INCORRECT ON EXEMPT")

 ;

 K XUFDA S XUFDA(200,IENS,41.98)="D" D FILE^DIE("","XUFDA")

 D CHKEQ^XTMUNIT($$NPISTATS^XUSNPIED(DUZ),"D","INCORRECT ON DONE")

 ;

 K XUFDA S XUFDA(200,IENS,41.98)=$S(OLDVALUE'="":$E(OLDVALUE),1:"@")

 Q

 ;

GETTAXON ;

 N XUSGLOB,DONE,IEN,TAXON,PVAL,CODE,DESCRIP,TAXDESCR

 S XUSGLOB=$$CHKGLOB^XUSNPIED()

 S DONE=0 F IEN=0:0 Q:DONE  S IEN=$O(^VA(200,IEN)) Q:IEN'>0  F TAXON=0:0 S TAXON=$O(^VA(200,IEN,"USC1",TAXON)) Q:TAXON'>0  I $P(^(TAXON,0),U,3)'>0  S PVAL=$P(^(0),U),CODE=$$GET1^DIQ(8932.1,PVAL_",",6) I CODE'="",$D(@XUSGLOB@(CODE)) S DONE=1 Q

 I 'DONE D FAIL^XTMUNIT("NO VALID TAXONOMY VALUES FOUND") Q

 S TAXDESCR=$$GET1^DIQ(8932.1,PVAL_",",1)

 S DESCRIP=""

 I CODE'="" S TAXON=$$GETTAXON^XUSNPIED(IEN,.DESCRIP)

 D CHKEQ^XTMUNIT(TAXON,CODE,"INCORRECT CODE RETURNED")

 D CHKEQ^XTMUNIT(DESCRIP,TAXDESCR,"INCORRECT DESCRIPTION RETURNED")

 Q

 ;

XTROU ;

 ;

XTENT ;

 ;;ALIGNRGT;LEFT ALIGN TEXT IN A SPECIFIED WIDTH

 ;;NEEDSNPI;CHECK ON NEEDS NPI STATUS

 ;;HASNPI;CHECK ON WHETHER USER HAS NPI

 ;;GETNPI;GET NPI VALUE FOR USER

 ;;NPISTATS;GET NPI STATUS

 ;;GETTAXON;GET TAXONOMY DATA

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---XUSNPIUT   3643     printed  Apr 23, 2025@18:27:16                                                                                                                                                                                                    Page 2

XUSNPIUT  ;JLI/FO-OAK - UNIT TEST ROUTINE FOR NPI WORK ;5/12/06  08:54

 +1       ;;8.0;KERNEL;**420**;Jul 10, 1995;Build 20

 +2        IF $TEXT(EN^XTMUNIT)'=""

               DO EN^XTMUNIT("XUSNPIUT")

 +3        QUIT 

 +4       ;

ALIGNRGT  ;

 +1        DO CHKEQ^XTMUNIT($$ALIGNRGT^XUSNPIED("TEXT1",10),"     TEXT1","INCORRECT RETURN VALUE")

 +2        DO CHKEQ^XTMUNIT($$ALIGNRGT^XUSNPIED("AA AA",6)," AA AA","INCORRECT RETURN VALUE")

 +3        QUIT 

 +4       ;

NEEDSNPI  ;

 +1        NEW OLDVALUE,NEWVALUE,XUFDA,IENS

 +2        SET IENS=DUZ_","

 +3        SET OLDVALUE=$$GET1^DIQ(200,IENS,41.98)

 +4        KILL XUFDA

           SET XUFDA(200,IENS,41.98)="@"

           DO FILE^DIE("","XUFDA")

 +5        DO CHKEQ^XTMUNIT($$NEEDSNPI^XUSNPIED(DUZ),0,"INCORRECT OR NO DATA")

 +6       ;

 +7        KILL XUFDA

           SET XUFDA(200,IENS,41.98)="N"

           DO FILE^DIE("","XUFDA")

 +8        DO CHKEQ^XTMUNIT($$NEEDSNPI^XUSNPIED(DUZ),1,"INCORRECT ON NEEDS")

 +9       ;

 +10       KILL XUFDA

           SET XUFDA(200,IENS,41.98)="E"

           DO FILE^DIE("","XUFDA")

 +11       DO CHKEQ^XTMUNIT($$NEEDSNPI^XUSNPIED(DUZ),0,"INCORRECT ON EXEMPT")

 +12      ;

 +13       KILL XUFDA

           SET XUFDA(200,IENS,41.98)="D"

           DO FILE^DIE("","XUFDA")

 +14       DO CHKEQ^XTMUNIT($$NEEDSNPI^XUSNPIED(DUZ),0,"INCORRECT ON DONE")

 +15      ;

 +16       KILL XUFDA

           SET XUFDA(200,IENS,41.98)=$SELECT(OLDVALUE'="":OLDVALUE,1:"@")

 +17       QUIT 

 +18      ;

HASNPI    ;

 +1        NEW OLDVALUE,NEWVALUE,XUFDA,IENS

 +2        SET IENS=DUZ_","

 +3        SET OLDVALUE=$$GET1^DIQ(200,IENS,41.98)

 +4        KILL XUFDA

           SET XUFDA(200,IENS,41.98)="@"

           DO FILE^DIE("","XUFDA")

 +5        DO CHKEQ^XTMUNIT($$HASNPI^XUSNPIED(DUZ),0,"INCORRECT ON NO DATA")

 +6       ;

 +7        KILL XUFDA

           SET XUFDA(200,IENS,41.98)="N"

           DO FILE^DIE("","XUFDA")

 +8        DO CHKEQ^XTMUNIT($$HASNPI^XUSNPIED(DUZ),0,"INCORRECT ON NEEDS")

 +9       ;

 +10       KILL XUFDA

           SET XUFDA(200,IENS,41.98)="E"

           DO FILE^DIE("","XUFDA")

 +11       DO CHKEQ^XTMUNIT($$HASNPI^XUSNPIED(DUZ),0,"INCORRECT ON EXEMPT")

 +12      ;

 +13       KILL XUFDA

           SET XUFDA(200,IENS,41.98)="D"

           DO FILE^DIE("","XUFDA")

 +14       DO CHKEQ^XTMUNIT($$HASNPI^XUSNPIED(DUZ),1,"INCORRECT ON DONE")

 +15      ;

 +16       KILL XUFDA

           SET XUFDA(200,IENS,41.98)=$SELECT(OLDVALUE'="":$EXTRACT(OLDVALUE),1:"@")

 +17       QUIT 

 +18      ;

GETNPI    ;

 +1        NEW I,VALUE

 +2        FOR I=0:0

               SET I=$ORDER(^VA(200,I))

               if I'>0

                   QUIT 

               IF $GET(^VA(200,I,"NPI"))'=""

                   QUIT 

 +3        IF I'>0

               DO FAIL^XTMUNIT("NO VALID DATA AVAILABLE")

               QUIT 

 +4        SET VALUE=$$GET1^DIQ(200,I_",",41.99)

 +5        DO CHKEQ^XTMUNIT($$GETNPI^XUSNPIED(I),VALUE,"INCORRECT VALUE RETURNED")

 +6        QUIT 

 +7       ;

NPISTATS  ;

 +1        NEW OLDVALUE,NEWVALUE,XUFDA,IENS

 +2        SET IENS=DUZ_","

 +3        SET OLDVALUE=$$GET1^DIQ(200,IENS,41.98)

 +4        KILL XUFDA

           SET XUFDA(200,IENS,41.98)="@"

           DO FILE^DIE("","XUFDA")

 +5        DO CHKEQ^XTMUNIT($$NPISTATS^XUSNPIED(DUZ),"","INCORRECT ON NO DATA")

 +6       ;

 +7        KILL XUFDA

           SET XUFDA(200,IENS,41.98)="N"

           DO FILE^DIE("","XUFDA")

 +8        DO CHKEQ^XTMUNIT($$NPISTATS^XUSNPIED(DUZ),"N","INCORRECT ON NEEDS")

 +9       ;

 +10       KILL XUFDA

           SET XUFDA(200,IENS,41.98)="E"

           DO FILE^DIE("","XUFDA")

 +11       DO CHKEQ^XTMUNIT($$NPISTATS^XUSNPIED(DUZ),"E","INCORRECT ON EXEMPT")

 +12      ;

 +13       KILL XUFDA

           SET XUFDA(200,IENS,41.98)="D"

           DO FILE^DIE("","XUFDA")

 +14       DO CHKEQ^XTMUNIT($$NPISTATS^XUSNPIED(DUZ),"D","INCORRECT ON DONE")

 +15      ;

 +16       KILL XUFDA

           SET XUFDA(200,IENS,41.98)=$SELECT(OLDVALUE'="":$EXTRACT(OLDVALUE),1:"@")

 +17       QUIT 

 +18      ;

GETTAXON  ;

 +1        NEW XUSGLOB,DONE,IEN,TAXON,PVAL,CODE,DESCRIP,TAXDESCR

 +2        SET XUSGLOB=$$CHKGLOB^XUSNPIED()

 +3        SET DONE=0

           FOR IEN=0:0

               if DONE

                   QUIT 

               SET IEN=$ORDER(^VA(200,IEN))

               if IEN'>0

                   QUIT 

               FOR TAXON=0:0

                   SET TAXON=$ORDER(^VA(200,IEN,"USC1",TAXON))

                   if TAXON'>0

                       QUIT 

                   IF $PIECE(^(TAXON,0),U,3)'>0

                       SET PVAL=$PIECE(^(0),U)

                       SET CODE=$$GET1^DIQ(8932.1,PVAL_",",6)

                       IF CODE'=""

                           IF $DATA(@XUSGLOB@(CODE))

                               SET DONE=1

                               QUIT 

 +4        IF 'DONE

               DO FAIL^XTMUNIT("NO VALID TAXONOMY VALUES FOUND")

               QUIT 

 +5        SET TAXDESCR=$$GET1^DIQ(8932.1,PVAL_",",1)

 +6        SET DESCRIP=""

 +7        IF CODE'=""

               SET TAXON=$$GETTAXON^XUSNPIED(IEN,.DESCRIP)

 +8        DO CHKEQ^XTMUNIT(TAXON,CODE,"INCORRECT CODE RETURNED")

 +9        DO CHKEQ^XTMUNIT(DESCRIP,TAXDESCR,"INCORRECT DESCRIPTION RETURNED")

 +10       QUIT 

 +11      ;

XTROU     ;

 +1       ;

XTENT     ;

 +1       ;;ALIGNRGT;LEFT ALIGN TEXT IN A SPECIFIED WIDTH

 +2       ;;NEEDSNPI;CHECK ON NEEDS NPI STATUS

 +3       ;;HASNPI;CHECK ON WHETHER USER HAS NPI

 +4       ;;GETNPI;GET NPI VALUE FOR USER

 +5       ;;NPISTATS;GET NPI STATUS

 +6       ;;GETTAXON;GET TAXONOMY DATA