source: FOIAVistA/trunk/r/MEDICINE-MC/MCNP2CHK.m@ 1607

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

initial load of FOIAVistA 6/30/08 version

File size: 3.1 KB
Line 
1MCNP2CHK ;HIRMFO/DAD-UNIQUE PROVIDER NAME PRINT ;4/18/96 08:33
2 ;;2.3;Medicine;;09/13/1996
3 ;
4 K %ZIS,IOP S %ZIS="QM" W ! D ^%ZIS G:POP EXIT
5 I $D(IO("Q")) D G EXIT
6 . S ZTRTN="TASK^MCNP2CHK"
7 . S ZTDESC="Unique New Person Names in Medicine Provider Fields"
8 . D ^%ZTLOAD S ZTSK=+$G(ZTSK)
9 . I ZTSK>0 W !!,"Task queued, task number ",ZTSK,"."
10 . E W !!,"Task not queued."
11 . Q
12TASK ;
13 D XIT
14 F MCLINE=1:1 S MCDATA=$P($T(FILEFLD+MCLINE),";",3) Q:MCDATA="" D
15 . K MCFLD
16 . S MCFILE=$P(MCDATA,U),MCFLD(0)=$P(MCDATA,U,2)
17 . S ^TMP("MC",$J,MCFILE)=$$GET1^DID(MCFILE,"","","NAME")
18 . F MCPIECE=1:1:$L(MCFLD(0),",") D
19 .. S MCFLD=$P(MCFLD(0),",",MCPIECE) Q:MCFLD'>0
20 .. K MCDD,MCER
21 .. D FIELD^DID(MCFILE,MCFLD,"","LABEL;GLOBAL SUBSCRIPT LOCATION","MCDD","MCERR")
22 .. S MCFLD(MCFLD)=MCDD("GLOBAL SUBSCRIPT LOCATION")
23 .. S ^TMP("MC",$J,MCFILE,MCFLD)=MCDD("LABEL")
24 .. Q
25 . D GETDATA
26 . Q
27PRINT ;
28 K MCUNDL S MCPAGE=1,MCEXIT=0,$P(MCUNDL,"=",81)=""
29 S MCTODAY=$$FMTE^XLFDT($$DT^XLFDT)
30 U IO D HEADER
31 S MCFILE=0
32 F S MCFILE=$O(^TMP("MC",$J,MCFILE)) Q:MCFILE'>0!MCEXIT D
33 . W !!,^TMP("MC",$J,MCFILE)," file (#",MCFILE,")"
34 . S MCFLD=0
35 . F S MCFLD=$O(^TMP("MC",$J,MCFILE,MCFLD)) Q:MCFLD'>0!MCEXIT D
36 .. W !?5,^TMP("MC",$J,MCFILE,MCFLD)," field (#",MCFLD,")"
37 .. I $O(^TMP("MC",$J,MCFILE,MCFLD,""))="" D Q
38 ... W !?10,"*** NONE ***"
39 ... I $Y>(IOSL-4) D PAUSE,HEADER
40 ... Q
41 .. S MCPROV=""
42 .. F S MCPROV=$O(^TMP("MC",$J,MCFILE,MCFLD,MCPROV)) Q:MCPROV=""!MCEXIT D
43 ... S MCDATA=^TMP("MC",$J,MCFILE,MCFLD,MCPROV)
44 ... W !?10,MCPROV,?50,$J($P(MCDATA,U),6),?65,$S($P(MCDATA,U,2):"YES",1:"NO")
45 ... I $Y>(IOSL-4) D PAUSE,HEADER
46 ... Q
47 .. Q
48 . Q
49EXIT ;
50 D ^%ZISC
51XIT K %ZIS,DIR,DIRUT,DIROUT,DTOUT,MC200,MCD0,MCD1,MCDATA,MCDD,MCER,MCEXIT
52 K MCFILE,MCFLD,MCLINE,MCNODE,MCPAGE,MCPIECE,MCPROV,MCTODAY,MCUNDL,POP
53 K X,Y,ZTDESC,ZTRTN,^TMP("MC",$J)
54 Q
55GETDATA ;
56 S MCD0=0
57 F S MCD0=$O(^MCAR(MCFILE,MCD0)) Q:MCD0'>0 D
58 . S MCFLD=0
59 . F S MCFLD=$O(MCFLD(MCFLD)) Q:MCFLD'>0 D
60 .. I MCFILE=700,MCFLD=21 D GETMULT Q
61 .. S MCNODE=$P(MCFLD(MCFLD),";"),MCPIECE=$P(MCFLD(MCFLD),";",2)
62 .. S MC200=$P($G(^MCAR(MCFILE,MCD0,MCNODE)),U,MCPIECE)
63 .. D SETTMP(MC200)
64 .. Q
65 . Q
66 Q
67GETMULT ;
68 S MCD1=0
69 F S MCD1=$O(^MCAR(MCFILE,MCD0,7,MCD1)) Q:MCD1'>0 D
70 . S MC200=$P($G(^MCAR(MCFILE,MCD0,7,MCD1,0)),U)
71 . D SETTMP(MC200)
72 . Q
73 Q
74SETTMP(MC200) ;
75 I MC200="" Q
76 S MC200(0)=$P($G(^VA(200,MC200,0)),U) I MC200(0)="" S MC200(0)=MC200
77 I $D(^TMP("MC",$J,MCFILE,MCFLD,MC200(0)))[0 D
78 . S MCPROV=$D(^XUSEC("PROVIDER",MC200))
79 . S ^TMP("MC",$J,MCFILE,MCFLD,MC200(0))=MC200_U_$S(MCPROV[0:0,1:1)
80 . Q
81 Q
82PAUSE ;
83 I $E(IOST,1,2)="C-" D
84 . N DIR S DIR(0)="E" D ^DIR S MCEXIT=$S(Y'>0:1,1:0)
85 . Q
86 Q
87HEADER ;
88 I MCEXIT Q
89 W:($E(IOST,1,2)="C-")!(MCPAGE>1) @IOF
90 W !?15,"Unique New Person Names in Medicine Provider Fields"
91 W ?68,MCTODAY,!?68,"Page: ",MCPAGE S MCPAGE=MCPAGE+1
92 W !,"File Name (Number)"
93 W !?5,"Field Name (Number)"
94 W !?10,"New Person Name",?50,"IEN",?65,"Provider Key",!,MCUNDL
95 Q
96FILEFLD ;;
97 ;;691^39,43
98 ;;691.1^62,63,64,65
99 ;;691.5^12
100 ;;691.6^4,6,10,12,14
101 ;;691.7^57,58
102 ;;691.8^16,17,19,20
103 ;;691.9^24
104 ;;692^21
105 ;;694^50,51
106 ;;698.3^2
107 ;;699^6,200,201
108 ;;700^10,21,31,34
Note: See TracBrowser for help on using the repository browser.