VistA-FOIAVistA/r/PATIENT_DATA_EXCHANGE-VAQ/VAQPST25.m

71 lines
2.1 KiB
Mathematica

VAQPST25 ;ALB/JRP - POST INIT (FILE CONVERSION);29-JUL-93
;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
CNVRT1 ;COMPLETE FILE CONVERSION FOR UNSOLICITED PDX & RESULTS TO A REQUEST
;CONTINUATION FOR RESULTS^VAQPST23
; DECLARATIONS DONE IN CALLING ROUTINE
;BUILD PREPARSED ARRAY
K @PREPAR
;BUILD HEADER BLOCK
S LINE=$P(NODE0,"^",3)
F TMP=4,5,6,7,8,10,19,1,20 S LINE=LINE_"^"_$P(NODE0,"^",TMP)
S LINE=LINE_"^100"
F TMP=12,2,15,16,17 S LINE=LINE_"^"_$P(NODE0,"^",TMP)
I (STATUS=UNSPTR) D
.S $P(LINE,"^",1)=""
.S $P(LINE,"^",13)=""
.S $P(LINE,"^",7)=""
.S $P(LINE,"^",8)="UNSOLICITED"
S TMP=$P($G(^VAT(394.3,STATUS,0)),"^",1)
S $P(LINE,"^",12)=TMP
S @PREPAR@(1,"HEADER",1)=LINE
S @PREPAR@(1,"HEADER",2)=NODE1
;BUILD DATA BLOCKS
F BLOCK="MIN","MAS","PHA" D
.Q:('$D(^VAT(394.1,PTR10,BLOCK)))
.S LINE=1
.S TMP=0
.F S TMP=$O(^VAT(394.1,PTR10,BLOCK,TMP)) Q:(TMP="") D
..S @PREPAR@(1,BLOCK,LINE)=$G(^VAT(394.1,PTR10,BLOCK,TMP,0))
..S LINE=LINE+1
;PARSE AND KILL THE PREPARSED ARRAY
S XMER="" D PARSE10^VAQPAR1(PREPAR) K @PREPAR@(1)
I (XMER<0) S ERRCNT=ERRCNT+1 Q
;STORE DATA
S PTR15=0
;FILE HEADER BLOCK
S TMP=$$HEADER^VAQFIL10(2,PREPAR)
I ($P(TMP,"^",1)="-1") D ERROR Q
S PTR15=+TMP
;SET PURGER FLAG - PREVENTS USER FROM VIEWING TRANSACTION
S TMP=$$FILEINFO^VAQFILE(394.61,PTR15,90,"YES")
;FILE DOMAIN BLOCK
S TMP=$$DOMAIN^VAQFIL12(2,PREPAR,PTR15)
I ($P(TMP,"^",1)="-1") D ERROR Q
;FILE USER BLOCK
S TMP=$$USER^VAQFIL13(2,PREPAR,PTR15)
I ($P(TMP,"^",1)="-1") D ERROR Q
;FILE PATIENT BLOCK
S TMP=$$PATIENT^VAQFIL15(2,PREPAR,PTR15)
I ($P(TMP,"^",1)="-1") D ERROR Q
;FILE SEGMENT BLOCK
S TMP=$$SEGMENT^VAQFIL16(2,PREPAR,PTR15)
I ($P(TMP,"^",1)="-1") D ERROR Q
;FILE COMMENT BLOCK
S TMP=$$COMMENT^VAQFIL14(2,PREPAR,PTR15)
I ($P(TMP,"^",1)="-1") D ERROR Q
;FILE ALL DATA BLOCKS
S TMP=$$DATA^VAQFIL18(2,PREPAR,PTR15)
I ($P(TMP,"^",1)="-1") D ERROR Q
;RESET PURGE FLAG - ALLOW USER TO VIEW TRANSACTION
S TMP=$$FILEINFO^VAQFILE(394.61,PTR15,90,"NO")
K @PREPAR
Q
ERROR ;ERROR FILING NEW TRANSACTION
S ERRCNT=ERRCNT+1
K @PREPAR
;NEW TRANSACTION WASN'T CREATED
Q:('PTR15)
;DELETE NEW TRANSACTION
S TMP=$$DELTRAN^VAQFILE(PTR15)
Q