| [613] | 1 | VAQLED04 ;ALB/JFP - CREATES COMPARE ARRAYS FOR LOAD EDIT;01APR93 | 
|---|
|  | 2 | ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993 | 
|---|
|  | 3 | MAIN ;-- Main entry point | 
|---|
|  | 4 | N VAQIGNC,ROOT,SEGPTR | 
|---|
|  | 5 | D:$D(XRTL) T0^%ZOSV ; -- Capacity start | 
|---|
|  | 6 | W !!,"Please wait while MAS information is collected..." | 
|---|
|  | 7 | S VAQIGNC=1 | 
|---|
|  | 8 | S SEGPTR=$O(^VAT(394.71,"C","PDX*MAS","")) | 
|---|
|  | 9 | I $D(^VAT(394.61,DFNTR,"SEG","B",SEGPTR)) D EXTR,EXIT QUIT | 
|---|
|  | 10 | S SEGPTR=$O(^VAT(394.71,"C","PDX*MIN","")) | 
|---|
|  | 11 | D EXTR,EXIT | 
|---|
|  | 12 | S:$D(XRT0) XRTN=$T(+0) D:$D(XRT0) T1^%ZOSV ; -- Capacity stop | 
|---|
|  | 13 | QUIT | 
|---|
|  | 14 | ; | 
|---|
|  | 15 | EXTR ; -- loads extraction arrays | 
|---|
|  | 16 | S ROOT="^TMP(""VAQTR"",$J)" | 
|---|
|  | 17 | K @ROOT | 
|---|
|  | 18 | S X=$$SEGEXT^VAQUPD1(DFNTR,SEGPTR,ROOT) | 
|---|
|  | 19 | I X=-1 W !,"     Error extracting ",$P($G(^VAT(394.71,SEGPTR,0)),U,2)," segment" | 
|---|
|  | 20 | ; | 
|---|
|  | 21 | S ROOT="^TMP(""VAQPT"",$J)" | 
|---|
|  | 22 | K @ROOT | 
|---|
|  | 23 | S X=$$SEGXTRCT^VAQDBI(0,DFNPT,ROOT,SEGPTR) | 
|---|
|  | 24 | I X=-1 W !,"     Error extracting ",$P($G(^VAT(394.71,SEGPTR,0)),U,2)," MAS data patient file" | 
|---|
|  | 25 | QUIT | 
|---|
|  | 26 | ; | 
|---|
|  | 27 | EXIT ; -- Cleans up variables | 
|---|
|  | 28 | K VAQIGNC,X,ROOT,SEGPTR | 
|---|
|  | 29 | QUIT | 
|---|
|  | 30 | ; | 
|---|
|  | 31 | END ; -- End of code | 
|---|
|  | 32 | QUIT | 
|---|