| [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
 | 
|---|