source: WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XUSNPIUT.m@ 1582

Last change on this file since 1582 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.5 KB
RevLine 
[613]1XUSNPIUT ;JLI/FO-OAK - UNIT TEST ROUTINE FOR NPI WORK ;5/12/06 08:54
2 ;;8.0;KERNEL;**420**;Jul 10, 1995;Build 20
3 I $T(EN^XTMUNIT)'="" D EN^XTMUNIT("XUSNPIUT")
4 Q
5 ;
6ALIGNRGT ;
7 D CHKEQ^XTMUNIT($$ALIGNRGT^XUSNPIED("TEXT1",10)," TEXT1","INCORRECT RETURN VALUE")
8 D CHKEQ^XTMUNIT($$ALIGNRGT^XUSNPIED("AA AA",6)," AA AA","INCORRECT RETURN VALUE")
9 Q
10 ;
11NEEDSNPI ;
12 N OLDVALUE,NEWVALUE,XUFDA,IENS
13 S IENS=DUZ_","
14 S OLDVALUE=$$GET1^DIQ(200,IENS,41.98)
15 K XUFDA S XUFDA(200,IENS,41.98)="@" D FILE^DIE("","XUFDA")
16 D CHKEQ^XTMUNIT($$NEEDSNPI^XUSNPIED(DUZ),0,"INCORRECT OR NO DATA")
17 ;
18 K XUFDA S XUFDA(200,IENS,41.98)="N" D FILE^DIE("","XUFDA")
19 D CHKEQ^XTMUNIT($$NEEDSNPI^XUSNPIED(DUZ),1,"INCORRECT ON NEEDS")
20 ;
21 K XUFDA S XUFDA(200,IENS,41.98)="E" D FILE^DIE("","XUFDA")
22 D CHKEQ^XTMUNIT($$NEEDSNPI^XUSNPIED(DUZ),0,"INCORRECT ON EXEMPT")
23 ;
24 K XUFDA S XUFDA(200,IENS,41.98)="D" D FILE^DIE("","XUFDA")
25 D CHKEQ^XTMUNIT($$NEEDSNPI^XUSNPIED(DUZ),0,"INCORRECT ON DONE")
26 ;
27 K XUFDA S XUFDA(200,IENS,41.98)=$S(OLDVALUE'="":OLDVALUE,1:"@")
28 Q
29 ;
30HASNPI ;
31 N OLDVALUE,NEWVALUE,XUFDA,IENS
32 S IENS=DUZ_","
33 S OLDVALUE=$$GET1^DIQ(200,IENS,41.98)
34 K XUFDA S XUFDA(200,IENS,41.98)="@" D FILE^DIE("","XUFDA")
35 D CHKEQ^XTMUNIT($$HASNPI^XUSNPIED(DUZ),0,"INCORRECT ON NO DATA")
36 ;
37 K XUFDA S XUFDA(200,IENS,41.98)="N" D FILE^DIE("","XUFDA")
38 D CHKEQ^XTMUNIT($$HASNPI^XUSNPIED(DUZ),0,"INCORRECT ON NEEDS")
39 ;
40 K XUFDA S XUFDA(200,IENS,41.98)="E" D FILE^DIE("","XUFDA")
41 D CHKEQ^XTMUNIT($$HASNPI^XUSNPIED(DUZ),0,"INCORRECT ON EXEMPT")
42 ;
43 K XUFDA S XUFDA(200,IENS,41.98)="D" D FILE^DIE("","XUFDA")
44 D CHKEQ^XTMUNIT($$HASNPI^XUSNPIED(DUZ),1,"INCORRECT ON DONE")
45 ;
46 K XUFDA S XUFDA(200,IENS,41.98)=$S(OLDVALUE'="":$E(OLDVALUE),1:"@")
47 Q
48 ;
49GETNPI ;
50 N I,VALUE
51 F I=0:0 S I=$O(^VA(200,I)) Q:I'>0 I $G(^VA(200,I,"NPI"))'="" Q
52 I I'>0 D FAIL^XTMUNIT("NO VALID DATA AVAILABLE") Q
53 S VALUE=$$GET1^DIQ(200,I_",",41.99)
54 D CHKEQ^XTMUNIT($$GETNPI^XUSNPIED(I),VALUE,"INCORRECT VALUE RETURNED")
55 Q
56 ;
57NPISTATS ;
58 N OLDVALUE,NEWVALUE,XUFDA,IENS
59 S IENS=DUZ_","
60 S OLDVALUE=$$GET1^DIQ(200,IENS,41.98)
61 K XUFDA S XUFDA(200,IENS,41.98)="@" D FILE^DIE("","XUFDA")
62 D CHKEQ^XTMUNIT($$NPISTATS^XUSNPIED(DUZ),"","INCORRECT ON NO DATA")
63 ;
64 K XUFDA S XUFDA(200,IENS,41.98)="N" D FILE^DIE("","XUFDA")
65 D CHKEQ^XTMUNIT($$NPISTATS^XUSNPIED(DUZ),"N","INCORRECT ON NEEDS")
66 ;
67 K XUFDA S XUFDA(200,IENS,41.98)="E" D FILE^DIE("","XUFDA")
68 D CHKEQ^XTMUNIT($$NPISTATS^XUSNPIED(DUZ),"E","INCORRECT ON EXEMPT")
69 ;
70 K XUFDA S XUFDA(200,IENS,41.98)="D" D FILE^DIE("","XUFDA")
71 D CHKEQ^XTMUNIT($$NPISTATS^XUSNPIED(DUZ),"D","INCORRECT ON DONE")
72 ;
73 K XUFDA S XUFDA(200,IENS,41.98)=$S(OLDVALUE'="":$E(OLDVALUE),1:"@")
74 Q
75 ;
76GETTAXON ;
77 N XUSGLOB,DONE,IEN,TAXON,PVAL,CODE,DESCRIP,TAXDESCR
78 S XUSGLOB=$$CHKGLOB^XUSNPIED()
79 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
80 I 'DONE D FAIL^XTMUNIT("NO VALID TAXONOMY VALUES FOUND") Q
81 S TAXDESCR=$$GET1^DIQ(8932.1,PVAL_",",1)
82 S DESCRIP=""
83 I CODE'="" S TAXON=$$GETTAXON^XUSNPIED(IEN,.DESCRIP)
84 D CHKEQ^XTMUNIT(TAXON,CODE,"INCORRECT CODE RETURNED")
85 D CHKEQ^XTMUNIT(DESCRIP,TAXDESCR,"INCORRECT DESCRIPTION RETURNED")
86 Q
87 ;
88XTROU ;
89 ;
90XTENT ;
91 ;;ALIGNRGT;LEFT ALIGN TEXT IN A SPECIFIED WIDTH
92 ;;NEEDSNPI;CHECK ON NEEDS NPI STATUS
93 ;;HASNPI;CHECK ON WHETHER USER HAS NPI
94 ;;GETNPI;GET NPI VALUE FOR USER
95 ;;NPISTATS;GET NPI STATUS
96 ;;GETTAXON;GET TAXONOMY DATA
Note: See TracBrowser for help on using the repository browser.