MCARUTL1.m

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

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