| 1 | MCNP2CHK ;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
|
|---|
| 12 | TASK ;
|
|---|
| 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
|
|---|
| 27 | PRINT ;
|
|---|
| 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
|
|---|
| 49 | EXIT ;
|
|---|
| 50 | D ^%ZISC
|
|---|
| 51 | XIT 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
|
|---|
| 55 | GETDATA ;
|
|---|
| 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
|
|---|
| 67 | GETMULT ;
|
|---|
| 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
|
|---|
| 74 | SETTMP(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
|
|---|
| 82 | PAUSE ;
|
|---|
| 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
|
|---|
| 87 | HEADER ;
|
|---|
| 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
|
|---|
| 96 | FILEFLD ;;
|
|---|
| 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
|
|---|
