| 1 | MCARUTL1 ;HOIFO/WAA-Utility Routine ;11/07/00  11:16
 | 
|---|
| 2 |  ;;2.3;Medicine;**29**;09/13/1996
 | 
|---|
| 3 |  ; 
 | 
|---|
| 4 |  ;    EN() This Entry point will SET/KILL the AV,AF,AS X-references
 | 
|---|
| 5 |  ;         for PULMONARY FUNCTION TESTS File (#700).
 | 
|---|
| 6 |  ;         FUNT = "SET","KILL" tells what X-ref action to execute
 | 
|---|
| 7 |  ;         IEN  = Internal Entry Number of File 700 entry
 | 
|---|
| 8 |  ;         PAT  = The internal Entry Number of the patient
 | 
|---|
| 9 |  ;         DATE = The Date of the procedure
 | 
|---|
| 10 |  ;         XREF = The Cross-Reference to be set.
 | 
|---|
| 11 |  ;                "ALL" all 3 cross references for the entry
 | 
|---|
| 12 |  ;                "AV" Volume Studies (Field 17, multiple field)
 | 
|---|
| 13 |  ;                "AF" Flow Studies   (Field 18, multiple field)
 | 
|---|
| 14 |  ;                "AS" Special Study  (Field 32, multiple field)
 | 
|---|
| 15 |  ;
 | 
|---|
| 16 | EN(FUNT,IEN,PAT,DATE,XREF) ; Main entry point to set or kill X-refs
 | 
|---|
| 17 |  Q:FUNT=""  ; Required to tell the program what function to do set/kill
 | 
|---|
| 18 |  Q:IEN=""  ; Required to tell the program what entry in 700 to X-ref 
 | 
|---|
| 19 |  Q:PAT=""  ; Required to tell the program what patient
 | 
|---|
| 20 |  Q:DATE=""  ; Required to tell the program the date of the Procedure
 | 
|---|
| 21 |  Q:XREF=""  ; Required to tell the program what X-ref
 | 
|---|
| 22 |  I FUNT'="SET",FUNT'="KILL" Q  ; Quit if the FUNT is not a set/kill
 | 
|---|
| 23 |  I '($D(^MCAR(700,IEN,0))#10) Q  ; Quit if there is no entry in 700
 | 
|---|
| 24 |  I XREF'="ALL" D PRO Q  ; tell the program that it is only one X-ref
 | 
|---|
| 25 |  I XREF="ALL" F XREF="AV","AF","AS" D PRO ; Tell the program all
 | 
|---|
| 26 |  Q
 | 
|---|
| 27 | PRO ; Process the data for the given cross-reference
 | 
|---|
| 28 |  N REFN ; this variable will contain the sub node of the entry 
 | 
|---|
| 29 |  S REFN=$S(XREF="AV":3,XREF="AF":4,XREF="AS":"S",1:0)
 | 
|---|
| 30 |  Q:REFN=0
 | 
|---|
| 31 |  Q:'$D(^MCAR(700,IEN,REFN))  ; Quit if there is no data for the entry
 | 
|---|
| 32 |  N ENT
 | 
|---|
| 33 |  S ENT=0
 | 
|---|
| 34 |  Q:($D(^MCAR(700,IEN,REFN,1))'=10)  ; no zero node or children
 | 
|---|
| 35 |  F  S ENT=$O(^MCAR(700,IEN,REFN,ENT)) Q:ENT<1  D  ; loop and get each entry
 | 
|---|
| 36 |  .Q:'($D(^MCAR(700,IEN,REFN,ENT,0))#10)  ; Quit if no entry
 | 
|---|
| 37 |  .N TYPE
 | 
|---|
| 38 |  .S TYPE=$P($G(^MCAR(700,IEN,REFN,ENT,0)),U) Q:TYPE=""
 | 
|---|
| 39 |  .D ACTION ; Fire off the cross reference
 | 
|---|
| 40 |  .Q
 | 
|---|
| 41 |  Q
 | 
|---|
| 42 | ACTION ;Set the data for the stated cross reference
 | 
|---|
| 43 |  N MCDD ; Protect DIC varables
 | 
|---|
| 44 |  I FUNT="SET" S ^MCAR(700,XREF,PAT,TYPE,(9999999.9999-DATE),IEN,ENT)="" Q
 | 
|---|
| 45 |  I FUNT="KILL" K ^MCAR(700,XREF,PAT,TYPE,(9999999.9999-DATE),IEN,ENT)
 | 
|---|
| 46 |  Q
 | 
|---|