| 1 | VAQPST25 ;ALB/JRP - POST INIT (FILE CONVERSION);29-JUL-93
|
|---|
| 2 | ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
|
|---|
| 3 | CNVRT1 ;COMPLETE FILE CONVERSION FOR UNSOLICITED PDX & RESULTS TO A REQUEST
|
|---|
| 4 | ;CONTINUATION FOR RESULTS^VAQPST23
|
|---|
| 5 | ; DECLARATIONS DONE IN CALLING ROUTINE
|
|---|
| 6 | ;BUILD PREPARSED ARRAY
|
|---|
| 7 | K @PREPAR
|
|---|
| 8 | ;BUILD HEADER BLOCK
|
|---|
| 9 | S LINE=$P(NODE0,"^",3)
|
|---|
| 10 | F TMP=4,5,6,7,8,10,19,1,20 S LINE=LINE_"^"_$P(NODE0,"^",TMP)
|
|---|
| 11 | S LINE=LINE_"^100"
|
|---|
| 12 | F TMP=12,2,15,16,17 S LINE=LINE_"^"_$P(NODE0,"^",TMP)
|
|---|
| 13 | I (STATUS=UNSPTR) D
|
|---|
| 14 | .S $P(LINE,"^",1)=""
|
|---|
| 15 | .S $P(LINE,"^",13)=""
|
|---|
| 16 | .S $P(LINE,"^",7)=""
|
|---|
| 17 | .S $P(LINE,"^",8)="UNSOLICITED"
|
|---|
| 18 | S TMP=$P($G(^VAT(394.3,STATUS,0)),"^",1)
|
|---|
| 19 | S $P(LINE,"^",12)=TMP
|
|---|
| 20 | S @PREPAR@(1,"HEADER",1)=LINE
|
|---|
| 21 | S @PREPAR@(1,"HEADER",2)=NODE1
|
|---|
| 22 | ;BUILD DATA BLOCKS
|
|---|
| 23 | F BLOCK="MIN","MAS","PHA" D
|
|---|
| 24 | .Q:('$D(^VAT(394.1,PTR10,BLOCK)))
|
|---|
| 25 | .S LINE=1
|
|---|
| 26 | .S TMP=0
|
|---|
| 27 | .F S TMP=$O(^VAT(394.1,PTR10,BLOCK,TMP)) Q:(TMP="") D
|
|---|
| 28 | ..S @PREPAR@(1,BLOCK,LINE)=$G(^VAT(394.1,PTR10,BLOCK,TMP,0))
|
|---|
| 29 | ..S LINE=LINE+1
|
|---|
| 30 | ;PARSE AND KILL THE PREPARSED ARRAY
|
|---|
| 31 | S XMER="" D PARSE10^VAQPAR1(PREPAR) K @PREPAR@(1)
|
|---|
| 32 | I (XMER<0) S ERRCNT=ERRCNT+1 Q
|
|---|
| 33 | ;STORE DATA
|
|---|
| 34 | S PTR15=0
|
|---|
| 35 | ;FILE HEADER BLOCK
|
|---|
| 36 | S TMP=$$HEADER^VAQFIL10(2,PREPAR)
|
|---|
| 37 | I ($P(TMP,"^",1)="-1") D ERROR Q
|
|---|
| 38 | S PTR15=+TMP
|
|---|
| 39 | ;SET PURGER FLAG - PREVENTS USER FROM VIEWING TRANSACTION
|
|---|
| 40 | S TMP=$$FILEINFO^VAQFILE(394.61,PTR15,90,"YES")
|
|---|
| 41 | ;FILE DOMAIN BLOCK
|
|---|
| 42 | S TMP=$$DOMAIN^VAQFIL12(2,PREPAR,PTR15)
|
|---|
| 43 | I ($P(TMP,"^",1)="-1") D ERROR Q
|
|---|
| 44 | ;FILE USER BLOCK
|
|---|
| 45 | S TMP=$$USER^VAQFIL13(2,PREPAR,PTR15)
|
|---|
| 46 | I ($P(TMP,"^",1)="-1") D ERROR Q
|
|---|
| 47 | ;FILE PATIENT BLOCK
|
|---|
| 48 | S TMP=$$PATIENT^VAQFIL15(2,PREPAR,PTR15)
|
|---|
| 49 | I ($P(TMP,"^",1)="-1") D ERROR Q
|
|---|
| 50 | ;FILE SEGMENT BLOCK
|
|---|
| 51 | S TMP=$$SEGMENT^VAQFIL16(2,PREPAR,PTR15)
|
|---|
| 52 | I ($P(TMP,"^",1)="-1") D ERROR Q
|
|---|
| 53 | ;FILE COMMENT BLOCK
|
|---|
| 54 | S TMP=$$COMMENT^VAQFIL14(2,PREPAR,PTR15)
|
|---|
| 55 | I ($P(TMP,"^",1)="-1") D ERROR Q
|
|---|
| 56 | ;FILE ALL DATA BLOCKS
|
|---|
| 57 | S TMP=$$DATA^VAQFIL18(2,PREPAR,PTR15)
|
|---|
| 58 | I ($P(TMP,"^",1)="-1") D ERROR Q
|
|---|
| 59 | ;RESET PURGE FLAG - ALLOW USER TO VIEW TRANSACTION
|
|---|
| 60 | S TMP=$$FILEINFO^VAQFILE(394.61,PTR15,90,"NO")
|
|---|
| 61 | K @PREPAR
|
|---|
| 62 | Q
|
|---|
| 63 | ERROR ;ERROR FILING NEW TRANSACTION
|
|---|
| 64 | S ERRCNT=ERRCNT+1
|
|---|
| 65 | K @PREPAR
|
|---|
| 66 | ;NEW TRANSACTION WASN'T CREATED
|
|---|
| 67 | Q:('PTR15)
|
|---|
| 68 | ;DELETE NEW TRANSACTION
|
|---|
| 69 | S TMP=$$DELTRAN^VAQFILE(PTR15)
|
|---|
| 70 | Q
|
|---|
