source: WorldVistAEHR/trunk/r/MEDICINE-MC/MCPOS0B.m@ 619

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

initial load of WorldVistAEHR

File size: 1.7 KB
Line 
1MCPOS0B ;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 ;
7START(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
17PROC(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 ;
27STUFF(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 ;
49SCODE(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
Note: See TracBrowser for help on using the repository browser.