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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQPST25 2243 printed Apr 09, 2024@21:27:14 Page 2
VAQPST25 ;ALB/JRP - POST INIT (FILE CONVERSION);29-JUL-93
+1 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
CNVRT1 ;COMPLETE FILE CONVERSION FOR UNSOLICITED PDX & RESULTS TO A REQUEST
+1 ;CONTINUATION FOR RESULTS^VAQPST23
+2 ; DECLARATIONS DONE IN CALLING ROUTINE
+3 ;BUILD PREPARSED ARRAY
+4 KILL @PREPAR
+5 ;BUILD HEADER BLOCK
+6 SET LINE=$PIECE(NODE0,"^",3)
+7 FOR TMP=4,5,6,7,8,10,19,1,20
SET LINE=LINE_"^"_$PIECE(NODE0,"^",TMP)
+8 SET LINE=LINE_"^100"
+9 FOR TMP=12,2,15,16,17
SET LINE=LINE_"^"_$PIECE(NODE0,"^",TMP)
+10 IF (STATUS=UNSPTR)
Begin DoDot:1
+11 SET $PIECE(LINE,"^",1)=""
+12 SET $PIECE(LINE,"^",13)=""
+13 SET $PIECE(LINE,"^",7)=""
+14 SET $PIECE(LINE,"^",8)="UNSOLICITED"
End DoDot:1
+15 SET TMP=$PIECE($GET(^VAT(394.3,STATUS,0)),"^",1)
+16 SET $PIECE(LINE,"^",12)=TMP
+17 SET @PREPAR@(1,"HEADER",1)=LINE
+18 SET @PREPAR@(1,"HEADER",2)=NODE1
+19 ;BUILD DATA BLOCKS
+20 FOR BLOCK="MIN","MAS","PHA"
Begin DoDot:1
+21 if ('$DATA(^VAT(394.1,PTR10,BLOCK)))
QUIT
+22 SET LINE=1
+23 SET TMP=0
+24 FOR
SET TMP=$ORDER(^VAT(394.1,PTR10,BLOCK,TMP))
if (TMP="")
QUIT
Begin DoDot:2
+25 SET @PREPAR@(1,BLOCK,LINE)=$GET(^VAT(394.1,PTR10,BLOCK,TMP,0))
+26 SET LINE=LINE+1
End DoDot:2
End DoDot:1
+27 ;PARSE AND KILL THE PREPARSED ARRAY
+28 SET XMER=""
DO PARSE10^VAQPAR1(PREPAR)
KILL @PREPAR@(1)
+29 IF (XMER<0)
SET ERRCNT=ERRCNT+1
QUIT
+30 ;STORE DATA
+31 SET PTR15=0
+32 ;FILE HEADER BLOCK
+33 SET TMP=$$HEADER^VAQFIL10(2,PREPAR)
+34 IF ($PIECE(TMP,"^",1)="-1")
DO ERROR
QUIT
+35 SET PTR15=+TMP
+36 ;SET PURGER FLAG - PREVENTS USER FROM VIEWING TRANSACTION
+37 SET TMP=$$FILEINFO^VAQFILE(394.61,PTR15,90,"YES")
+38 ;FILE DOMAIN BLOCK
+39 SET TMP=$$DOMAIN^VAQFIL12(2,PREPAR,PTR15)
+40 IF ($PIECE(TMP,"^",1)="-1")
DO ERROR
QUIT
+41 ;FILE USER BLOCK
+42 SET TMP=$$USER^VAQFIL13(2,PREPAR,PTR15)
+43 IF ($PIECE(TMP,"^",1)="-1")
DO ERROR
QUIT
+44 ;FILE PATIENT BLOCK
+45 SET TMP=$$PATIENT^VAQFIL15(2,PREPAR,PTR15)
+46 IF ($PIECE(TMP,"^",1)="-1")
DO ERROR
QUIT
+47 ;FILE SEGMENT BLOCK
+48 SET TMP=$$SEGMENT^VAQFIL16(2,PREPAR,PTR15)
+49 IF ($PIECE(TMP,"^",1)="-1")
DO ERROR
QUIT
+50 ;FILE COMMENT BLOCK
+51 SET TMP=$$COMMENT^VAQFIL14(2,PREPAR,PTR15)
+52 IF ($PIECE(TMP,"^",1)="-1")
DO ERROR
QUIT
+53 ;FILE ALL DATA BLOCKS
+54 SET TMP=$$DATA^VAQFIL18(2,PREPAR,PTR15)
+55 IF ($PIECE(TMP,"^",1)="-1")
DO ERROR
QUIT
+56 ;RESET PURGE FLAG - ALLOW USER TO VIEW TRANSACTION
+57 SET TMP=$$FILEINFO^VAQFILE(394.61,PTR15,90,"NO")
+58 KILL @PREPAR
+59 QUIT
ERROR ;ERROR FILING NEW TRANSACTION
+1 SET ERRCNT=ERRCNT+1
+2 KILL @PREPAR
+3 ;NEW TRANSACTION WASN'T CREATED
+4 if ('PTR15)
QUIT
+5 ;DELETE NEW TRANSACTION
+6 SET TMP=$$DELTRAN^VAQFILE(PTR15)
+7 QUIT
