| 1 | MCPOS0B ;HIRMFO/RMP,DAD-Medicine View file update ;5/1/96 13:30
|
|---|
| 2 | ;;2.3;Medicine;;09/13/1996
|
|---|
| 3 | ;
|
|---|
| 4 | D STUFF("MCPMV",690.2)
|
|---|
| 5 | Q
|
|---|
| 6 | ;
|
|---|
| 7 | START(FILE) ;DESIGNED TO CREATE MCPMV - Medicine View file
|
|---|
| 8 | N COUNT,TEMP,REC,PROC,CODE
|
|---|
| 9 | S COUNT=0,TEMP=""
|
|---|
| 10 | F S TEMP=$O(^MCAR(FILE,"B",TEMP)) Q:TEMP="" D
|
|---|
| 11 | . S REC=$O(^MCAR(FILE,"B",TEMP,""))
|
|---|
| 12 | . S COUNT=COUNT+1
|
|---|
| 13 | . S PROC=$S($D(^MCAR(FILE,REC,3)):$$PROC(REC),1:"")
|
|---|
| 14 | . W !,";;",$P(^MCAR(FILE,REC,0),U)_"^"_PROC
|
|---|
| 15 | . Q
|
|---|
| 16 | Q
|
|---|
| 17 | PROC(REC) ;
|
|---|
| 18 | N CNT,ARRAY,TEMP,SUBENTRY
|
|---|
| 19 | S CNT=0,(ARRAY)=""
|
|---|
| 20 | F S CNT=$O(^MCAR(FILE,REC,3,CNT)) Q:CNT'?1N.N D
|
|---|
| 21 | . S TEMP=$P(^MCAR(697.2,^MCAR(FILE,REC,3,CNT,0),0),U)
|
|---|
| 22 | . S:$L(ARRAY)>0 ARRAY=ARRAY_","
|
|---|
| 23 | . S ARRAY=ARRAY_TEMP
|
|---|
| 24 | . Q
|
|---|
| 25 | Q ARRAY
|
|---|
| 26 | ;
|
|---|
| 27 | STUFF(ROUTINE,FILE) ;ROUTINE is set to "MCPMV"
|
|---|
| 28 | ;FILE is set to 690.2
|
|---|
| 29 | N TEMP,COUNT,HOLD,VALUE,LOOP,MCD0,MCD1,MCDATA
|
|---|
| 30 | S MCDATA(1)=""
|
|---|
| 31 | S MCDATA(2)="Update the pointers from the Medicine View file (#690.2)"
|
|---|
| 32 | S MCDATA(3)="to the Procedure/Subspecialty file (#697.2)."
|
|---|
| 33 | D MES^XPDUTL(.MCDATA)
|
|---|
| 34 | ;
|
|---|
| 35 | F LOOP=1:1 S HOLD=$P($T(DATA+LOOP^@(ROUTINE)),";;",2) Q:HOLD="" D
|
|---|
| 36 | . S (DLAYGO,DIC)=FILE,DIC(0)="L"
|
|---|
| 37 | . S (VALUE,X)=$P(HOLD,U)
|
|---|
| 38 | . D ^DIC I Y=-1 K DIC,DA Q
|
|---|
| 39 | . S (MCD0,DA)=+Y
|
|---|
| 40 | . S MCD1=0
|
|---|
| 41 | . F S MCD1=$O(^MCAR(FILE,MCD0,3,MCD1)) Q:MCD1'>0 D
|
|---|
| 42 | .. S DIK="^MCAR("_FILE_","_MCD0_",3,",(D0,DA(1))=MCD0,(D1,DA)=MCD1
|
|---|
| 43 | .. D ^DIK
|
|---|
| 44 | .. Q
|
|---|
| 45 | . D SCODE($P(HOLD,U,2),MCD0,FILE)
|
|---|
| 46 | . Q
|
|---|
| 47 | Q
|
|---|
| 48 | ;
|
|---|
| 49 | SCODE(STEMP,SDA,FILE) ;
|
|---|
| 50 | N ENTRY,CODE,TYPE,DATE,LOOP
|
|---|
| 51 | F LOOP=1:1 S ENTRY=$P(STEMP,",",LOOP) Q:ENTRY="" D
|
|---|
| 52 | . K DD,DIC,DINUM,DO
|
|---|
| 53 | . S DA(1)=SDA,DIC="^MCAR("_FILE_","_DA(1)_",3,",DIC(0)="L"
|
|---|
| 54 | . S DIC("P")=$$GET1^DID(FILE,4,"","SPECIFIER"),DLAYGO=FILE
|
|---|
| 55 | . S (X,CODE)=$P(ENTRY,"~")
|
|---|
| 56 | . S X=+$O(^MCAR(697.2,"B",X,0))
|
|---|
| 57 | . I $P($G(^MCAR(697.2,X,0)),U)'=CODE Q
|
|---|
| 58 | . D FILE^DICN
|
|---|
| 59 | . K DIE,DR,DA,Y
|
|---|
| 60 | . Q
|
|---|
| 61 | Q
|
|---|
