VAQLED04 ;ALB/JFP - CREATES COMPARE ARRAYS FOR LOAD EDIT;01APR93
;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
MAIN ;-- Main entry point
N VAQIGNC,ROOT,SEGPTR
D:$D(XRTL) T0^%ZOSV ; -- Capacity start
W !!,"Please wait while MAS information is collected..."
S VAQIGNC=1
S SEGPTR=$O(^VAT(394.71,"C","PDX*MAS",""))
I $D(^VAT(394.61,DFNTR,"SEG","B",SEGPTR)) D EXTR,EXIT QUIT
S SEGPTR=$O(^VAT(394.71,"C","PDX*MIN",""))
D EXTR,EXIT
S:$D(XRT0) XRTN=$T(+0) D:$D(XRT0) T1^%ZOSV ; -- Capacity stop
QUIT
;
EXTR ; -- loads extraction arrays
S ROOT="^TMP(""VAQTR"",$J)"
K @ROOT
S X=$$SEGEXT^VAQUPD1(DFNTR,SEGPTR,ROOT)
I X=-1 W !," Error extracting ",$P($G(^VAT(394.71,SEGPTR,0)),U,2)," segment"
;
S ROOT="^TMP(""VAQPT"",$J)"
K @ROOT
S X=$$SEGXTRCT^VAQDBI(0,DFNPT,ROOT,SEGPTR)
I X=-1 W !," Error extracting ",$P($G(^VAT(394.71,SEGPTR,0)),U,2)," MAS data patient file"
QUIT
;
EXIT ; -- Cleans up variables
K VAQIGNC,X,ROOT,SEGPTR
QUIT
;
END ; -- End of code
QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQLED04 1010 printed Oct 16, 2024@18:26:45 Page 2
VAQLED04 ;ALB/JFP - CREATES COMPARE ARRAYS FOR LOAD EDIT;01APR93
+1 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
MAIN ;-- Main entry point
+1 NEW VAQIGNC,ROOT,SEGPTR
+2 ; -- Capacity start
if $DATA(XRTL)
DO T0^%ZOSV
+3 WRITE !!,"Please wait while MAS information is collected..."
+4 SET VAQIGNC=1
+5 SET SEGPTR=$ORDER(^VAT(394.71,"C","PDX*MAS",""))
+6 IF $DATA(^VAT(394.61,DFNTR,"SEG","B",SEGPTR))
DO EXTR
DO EXIT
QUIT
+7 SET SEGPTR=$ORDER(^VAT(394.71,"C","PDX*MIN",""))
+8 DO EXTR
DO EXIT
+9 ; -- Capacity stop
if $DATA(XRT0)
SET XRTN=$TEXT(+0)
if $DATA(XRT0)
DO T1^%ZOSV
+10 QUIT
+11 ;
EXTR ; -- loads extraction arrays
+1 SET ROOT="^TMP(""VAQTR"",$J)"
+2 KILL @ROOT
+3 SET X=$$SEGEXT^VAQUPD1(DFNTR,SEGPTR,ROOT)
+4 IF X=-1
WRITE !," Error extracting ",$PIECE($GET(^VAT(394.71,SEGPTR,0)),U,2)," segment"
+5 ;
+6 SET ROOT="^TMP(""VAQPT"",$J)"
+7 KILL @ROOT
+8 SET X=$$SEGXTRCT^VAQDBI(0,DFNPT,ROOT,SEGPTR)
+9 IF X=-1
WRITE !," Error extracting ",$PIECE($GET(^VAT(394.71,SEGPTR,0)),U,2)," MAS data patient file"
+10 QUIT
+11 ;
EXIT ; -- Cleans up variables
+1 KILL VAQIGNC,X,ROOT,SEGPTR
+2 QUIT
+3 ;
END ; -- End of code
+1 QUIT
