MCARUTL1 ;HOIFO/WAA-Utility Routine ;11/07/00 11:16
;;2.3;Medicine;**29**;09/13/1996
;
; EN() This Entry point will SET/KILL the AV,AF,AS X-references
; for PULMONARY FUNCTION TESTS File (#700).
; FUNT = "SET","KILL" tells what X-ref action to execute
; IEN = Internal Entry Number of File 700 entry
; PAT = The internal Entry Number of the patient
; DATE = The Date of the procedure
; XREF = The Cross-Reference to be set.
; "ALL" all 3 cross references for the entry
; "AV" Volume Studies (Field 17, multiple field)
; "AF" Flow Studies (Field 18, multiple field)
; "AS" Special Study (Field 32, multiple field)
;
EN(FUNT,IEN,PAT,DATE,XREF) ; Main entry point to set or kill X-refs
Q:FUNT="" ; Required to tell the program what function to do set/kill
Q:IEN="" ; Required to tell the program what entry in 700 to X-ref
Q:PAT="" ; Required to tell the program what patient
Q:DATE="" ; Required to tell the program the date of the Procedure
Q:XREF="" ; Required to tell the program what X-ref
I FUNT'="SET",FUNT'="KILL" Q ; Quit if the FUNT is not a set/kill
I '($D(^MCAR(700,IEN,0))#10) Q ; Quit if there is no entry in 700
I XREF'="ALL" D PRO Q ; tell the program that it is only one X-ref
I XREF="ALL" F XREF="AV","AF","AS" D PRO ; Tell the program all
Q
PRO ; Process the data for the given cross-reference
N REFN ; this variable will contain the sub node of the entry
S REFN=$S(XREF="AV":3,XREF="AF":4,XREF="AS":"S",1:0)
Q:REFN=0
Q:'$D(^MCAR(700,IEN,REFN)) ; Quit if there is no data for the entry
N ENT
S ENT=0
Q:($D(^MCAR(700,IEN,REFN,1))'=10) ; no zero node or children
F S ENT=$O(^MCAR(700,IEN,REFN,ENT)) Q:ENT<1 D ; loop and get each entry
.Q:'($D(^MCAR(700,IEN,REFN,ENT,0))#10) ; Quit if no entry
.N TYPE
.S TYPE=$P($G(^MCAR(700,IEN,REFN,ENT,0)),U) Q:TYPE=""
.D ACTION ; Fire off the cross reference
.Q
Q
ACTION ;Set the data for the stated cross reference
N MCDD ; Protect DIC varables
I FUNT="SET" S ^MCAR(700,XREF,PAT,TYPE,(9999999.9999-DATE),IEN,ENT)="" Q
I FUNT="KILL" K ^MCAR(700,XREF,PAT,TYPE,(9999999.9999-DATE),IEN,ENT)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMCARUTL1 2263 printed Nov 22, 2024@17:24:37 Page 2
MCARUTL1 ;HOIFO/WAA-Utility Routine ;11/07/00 11:16
+1 ;;2.3;Medicine;**29**;09/13/1996
+2 ;
+3 ; EN() This Entry point will SET/KILL the AV,AF,AS X-references
+4 ; for PULMONARY FUNCTION TESTS File (#700).
+5 ; FUNT = "SET","KILL" tells what X-ref action to execute
+6 ; IEN = Internal Entry Number of File 700 entry
+7 ; PAT = The internal Entry Number of the patient
+8 ; DATE = The Date of the procedure
+9 ; XREF = The Cross-Reference to be set.
+10 ; "ALL" all 3 cross references for the entry
+11 ; "AV" Volume Studies (Field 17, multiple field)
+12 ; "AF" Flow Studies (Field 18, multiple field)
+13 ; "AS" Special Study (Field 32, multiple field)
+14 ;
EN(FUNT,IEN,PAT,DATE,XREF) ; Main entry point to set or kill X-refs
+1 ; Required to tell the program what function to do set/kill
if FUNT=""
QUIT
+2 ; Required to tell the program what entry in 700 to X-ref
if IEN=""
QUIT
+3 ; Required to tell the program what patient
if PAT=""
QUIT
+4 ; Required to tell the program the date of the Procedure
if DATE=""
QUIT
+5 ; Required to tell the program what X-ref
if XREF=""
QUIT
+6 ; Quit if the FUNT is not a set/kill
IF FUNT'="SET"
IF FUNT'="KILL"
QUIT
+7 ; Quit if there is no entry in 700
IF '($DATA(^MCAR(700,IEN,0))#10)
QUIT
+8 ; tell the program that it is only one X-ref
IF XREF'="ALL"
DO PRO
QUIT
+9 ; Tell the program all
IF XREF="ALL"
FOR XREF="AV","AF","AS"
DO PRO
+10 QUIT
PRO ; Process the data for the given cross-reference
+1 ; this variable will contain the sub node of the entry
NEW REFN
+2 SET REFN=$SELECT(XREF="AV":3,XREF="AF":4,XREF="AS":"S",1:0)
+3 if REFN=0
QUIT
+4 ; Quit if there is no data for the entry
if '$DATA(^MCAR(700,IEN,REFN))
QUIT
+5 NEW ENT
+6 SET ENT=0
+7 ; no zero node or children
if ($DATA(^MCAR(700,IEN,REFN,1))'=10)
QUIT
+8 ; loop and get each entry
FOR
SET ENT=$ORDER(^MCAR(700,IEN,REFN,ENT))
if ENT<1
QUIT
Begin DoDot:1
+9 ; Quit if no entry
if '($DATA(^MCAR(700,IEN,REFN,ENT,0))#10)
QUIT
+10 NEW TYPE
+11 SET TYPE=$PIECE($GET(^MCAR(700,IEN,REFN,ENT,0)),U)
if TYPE=""
QUIT
+12 ; Fire off the cross reference
DO ACTION
+13 QUIT
End DoDot:1
+14 QUIT
ACTION ;Set the data for the stated cross reference
+1 ; Protect DIC varables
NEW MCDD
+2 IF FUNT="SET"
SET ^MCAR(700,XREF,PAT,TYPE,(9999999.9999-DATE),IEN,ENT)=""
QUIT
+3 IF FUNT="KILL"
KILL ^MCAR(700,XREF,PAT,TYPE,(9999999.9999-DATE),IEN,ENT)
+4 QUIT
