| 1 | MCPOS0C ;HIRMFO/RMP,DAD-ASTM file update ;7/24/96 08:39
|
|---|
| 2 | ;;2.3;Medicine;;09/13/1996
|
|---|
| 3 | ;
|
|---|
| 4 | D STUFF("MCPMVA",690.2)
|
|---|
| 5 | Q
|
|---|
| 6 | ;
|
|---|
| 7 | START(FILE) ;DESIGNED TO CREATE MCPMVA - Medicine View ASTM subfile
|
|---|
| 8 | ;Medicine View file entry - template name
|
|---|
| 9 | ;Subfile entires for Field Number
|
|---|
| 10 | ;SubSubfile entry for ASTM value
|
|---|
| 11 | N COUNT,TEMP,REC,PROC,CODE
|
|---|
| 12 | S COUNT=0,TEMP=""
|
|---|
| 13 | F S TEMP=$O(^MCAR(FILE,"B",TEMP)) Q:TEMP="" D
|
|---|
| 14 | . S REC=$O(^MCAR(FILE,"B",TEMP,""))
|
|---|
| 15 | . S TMP=$S($D(^MCAR(FILE,REC,1)):$$TMP(FILE,REC),1:"")
|
|---|
| 16 | . Q:TMP=""
|
|---|
| 17 | . W !,";;",$P(^MCAR(FILE,REC,0),U)_"^"_TMP
|
|---|
| 18 | . Q
|
|---|
| 19 | Q
|
|---|
| 20 | TMP(FILE,REC) ;FOR EVERY Template with ASTM pointers in the SUB OR
|
|---|
| 21 | ; SUBSUBfile structure GET ASTM ID's
|
|---|
| 22 | N CNT,ARRAY,TMP,SUBENTRY
|
|---|
| 23 | S CNT=0,(ARRAY)=""
|
|---|
| 24 | F S CNT=$O(^MCAR(FILE,REC,1,CNT)) Q:CNT'?1N.N D
|
|---|
| 25 | . S TMP=^MCAR(FILE,REC,1,CNT,0)
|
|---|
| 26 | . Q:$P(TMP,U,3)="" S SUBENTRY=$P(TMP,U),TMP=$P(TMP,U,3)
|
|---|
| 27 | . S TMP=$P(^MCAR(690.5,TMP,0),U,1,2),TMP=$TR(TMP,U,"~")
|
|---|
| 28 | . S TMP=SUBENTRY_"~"_TMP
|
|---|
| 29 | . S:$L(ARRAY)>0 ARRAY=ARRAY_","
|
|---|
| 30 | . S ARRAY=ARRAY_TMP
|
|---|
| 31 | . Q
|
|---|
| 32 | Q ARRAY
|
|---|
| 33 | ;
|
|---|
| 34 | STUFF(ROUTINE,TFILE) ;ROUTINE is set to "MCPMVA"
|
|---|
| 35 | ;FILE is set to 690.2
|
|---|
| 36 | N TEMP,COUNT,HOLD,VALUE,LOOP
|
|---|
| 37 | S MCDATA(1)=""
|
|---|
| 38 | S MCDATA(2)="Update the pointers from the Medicine View file (#690.2)"
|
|---|
| 39 | S MCDATA(3)="to the ASTM file (#690.5)."
|
|---|
| 40 | D MES^XPDUTL(.MCDATA)
|
|---|
| 41 | ;
|
|---|
| 42 | F LOOP=1:1 S HOLD=$P($T(DATA+LOOP^@(ROUTINE)),";;",2) Q:HOLD="" D
|
|---|
| 43 | . S (DLAYGO,DIC)=TFILE,DIC(0)="L"
|
|---|
| 44 | . S (VALUE,X)=$P(HOLD,U)
|
|---|
| 45 | . D ^DIC I Y=-1 K DIC,DA Q
|
|---|
| 46 | . S DA=+Y
|
|---|
| 47 | . D SCODE($P(HOLD,U,2),DA,TFILE)
|
|---|
| 48 | . Q
|
|---|
| 49 | Q
|
|---|
| 50 | ;
|
|---|
| 51 | SCODE(STEMP,SDA,FILE) ;
|
|---|
| 52 | N ENTRY,CODE,TYPE,DATE,LOOP
|
|---|
| 53 | F LOOP=1:1 S ENTRY=$P(STEMP,",",LOOP) Q:ENTRY="" D
|
|---|
| 54 | . S ASTM=$$ASTM(ENTRY)
|
|---|
| 55 | . S DA(1)=SDA,DIC="^MCAR("_FILE_","_DA(1)_",1,",DIC(0)="L"
|
|---|
| 56 | . S DIC("P")=$$GET1^DID(FILE,2,"","SPECIFIER"),DLAYGO=FILE
|
|---|
| 57 | . S (X,CODE)=$P(ENTRY,"~"),CODE2=$P(ENTRY,"~",2)
|
|---|
| 58 | . D ^DIC
|
|---|
| 59 | . I Y=-1 K DIC,DA Q
|
|---|
| 60 | . S DIE=DIC,DA=+Y K DIC
|
|---|
| 61 | . S DR="2////^S X=ASTM"
|
|---|
| 62 | . D ^DIE
|
|---|
| 63 | . K DIE,DR,DA,Y
|
|---|
| 64 | . Q
|
|---|
| 65 | Q
|
|---|
| 66 | ASTM(ENTRY) ;
|
|---|
| 67 | N TMP,ASTM S (ASTM,TMP)=""
|
|---|
| 68 | S (X,CODE)=$P(ENTRY,"~",2),CODE2=$P(ENTRY,"~",3)
|
|---|
| 69 | F Q:ASTM'="" S TMP=$O(^MCAR(690.5,"B",CODE,TMP)) Q:TMP="" D
|
|---|
| 70 | . S:$D(^MCAR(690.5,"C",CODE2,TMP)) ASTM=TMP
|
|---|
| 71 | . Q
|
|---|
| 72 | Q ASTM
|
|---|
