VAQFILE1 ;ALB/JRP/KLD - MESSAGE FILING;12-MAY-93 [ 09/16/96 9:44 AM ]
;;1.5;PATIENT DATA EXCHANGE;**22,34**;NOV 17, 1993
NEWDATA() ;MAKE NEW ENTRY IN DATA FILE
;INPUT : NONE
;OUTPUT : IFN - Success
; -1^Error_text - Error
;
;DECLARE VARIABLES
N DD,DIC,X,DINUM,Y,DLAYGO
S DIC="^VAT(394.62,",DLAYGO=394.62
S DIC(0)="L"
S X="+" ;-- auto numbering - see ^DD(394.62,.01,7.5). It involves $$AUTO^VAQXRF2(2) and file 394.86.
D ^DIC
I Y<0 Q "-1^Could not create entry in data file"
Q $P(Y,"^",1)
;
DELDATA(DA) ;DELETE ENTRY IN DATA FILE
;INPUT : DA - Pointer to VAQ - DATA file
;OUTPUT : 0 - Success
; -1^Error_text - Error
;
;CHECK INPUT
Q:('(+$G(DA))) "-1^Did not pass pointer to data"
;IF DATA DOES NOT EXIST RETURN SUCCESS
;Q:('$D(^VAT(394.62,DA))) 0
Q:('$D(^VAT(394.62,DA))) "-1^No Data Exist Record not Deleted"
;DECLARE VARIABLES
N DIK
;DELETE ENTRY
S DIK="^VAT(394.62,"
D ^DIK
Q:('$D(^VAT(394.62,DA))) 0
Q "-1^Unable to delete data"
;
DELSEG(SEG,TRAN) ;DELETE SEGMENT IN DATA FILE FOR A TRANSACTION
;INPUT : SEG - Segment abbreviation
; TRAN - Pointer to VAQ - TRANSACTION file
;OUTPUT : 0 - Success
; -1^Error_Text - Error
;
;CHECK INPUT
Q:($G(SEG)="") "-1^Did not pass segment abbreviation"
S TRAN=+$G(TRAN)
Q:(('TRAN)!('$D(^VAT(394.61,TRAN)))) "-1^Did not pass valid transaction"
;DECLARE VARIABLES
N DATAPTR,TMP,SEGPTR
;GET SEGMENT POINTER
S SEGPTR=+$O(^VAT(394.71,"C",SEG,""))
Q:('SEGPTR) "-1^Did not pass valid segment abbreviation"
;DELETE ENTRIES IN DATA FILE
S DATAPTR=""
F S DATAPTR=+$O(^VAT(394.62,"A-SEGMENT",TRAN,SEGPTR,"")) Q:('DATAPTR) S TMP=$$DELDATA(DATAPTR)
Q 0
;
STUBDATA(SEG,TRAN) ;CREATE STUB ENTRY IN DATA FILE
;INPUT : SEG - Segment abbreviation
; TRAN - Pointer to VAQ - TRANSACTION file
;OUTPUT : IFN - Success
; -1^Error_text - Error
;NOTES : The following fields (in addition to .01) will be filled in
; .02 - Segment
; .05 - Display Ready
; 40 - Transaction Number
;
;CHECK INPUT
Q:($G(SEG)="") "-1^Did not pass segment abbreviation"
S TRAN=+$G(TRAN)
Q:(('TRAN)!('$D(^VAT(394.61,TRAN)))) "-1^Did not pass valid transaction"
;DECLARE VARIABLES
N IFN,SEGNAME,TMP,TRANNUM,DIE,DR,Y,DA,DISPLAY
;GET SEGMENT NAME
S TMP=+$O(^VAT(394.71,"C",SEG,""))
Q:('TMP) "-1^Did not pass valid segment abbreviation"
S TMP=$G(^VAT(394.71,TMP,0))
S SEGNAME=$P(TMP,"^",1)
Q:(SEGNAME="") "-1^Could not determine segment name"
;DETERMINE IF SEGMENT IS DISPLAY READY
S DISPLAY=+$P(TMP,"^",3)
S DISPLAY=$S(DISPLAY:"YES",1:"NO")
;GET TRANSACTION NUMBER
S TRANNUM=+$G(^VAT(394.61,TRAN,0))
Q:('TRANNUM) "-1^Could not determine transaction number"
;MAKE ENTRY IN DATA FILE
S IFN=+$$NEWDATA
Q:(IFN<0) "-1^Could not create entry in data file"
;PLACE INFO IN NEW ENTRY
L +^VAT(394.62,IFN):60 I ('$T) S TMP=$$DELDATA(IFN) Q "-1^Could not edit entry (locked by other user)"
;PLACE SEGMENT NAME INTO DATA
S DIE="^VAT(394.62,"
S DA=IFN
S DR=".02///"_SEGNAME
D ^DIE
I ($D(Y)#2) L -^VAT(394.62,IFN) S TMP=$$DELDATA(IFN) Q "-1^Could not file segment name"
;PLACE DISPLAY READY FLAG INTO DATA
S DIE="^VAT(394.62,"
S DA=IFN
S DR=".05///"_DISPLAY
D ^DIE
I ($D(Y)#2) L -^VAT(394.62,IFN) S TMP=$$DELDATA(IFN) Q "-1^Could not file display ready flag"
;PLACE TRANSACTION NUBMER INTO DATA
S DIE="^VAT(394.62,"
S DA=IFN
S DR="40///"_TRANNUM
D ^DIE
I ($D(Y)#2) L -^VAT(394.62,IFN) S TMP=$$DELDATA(IFN) Q "-1^Could not file transaction number"
L -^VAT(394.62,IFN)
Q IFN
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQFILE1 3641 printed Oct 16, 2024@18:26:38 Page 2
VAQFILE1 ;ALB/JRP/KLD - MESSAGE FILING;12-MAY-93 [ 09/16/96 9:44 AM ]
+1 ;;1.5;PATIENT DATA EXCHANGE;**22,34**;NOV 17, 1993
NEWDATA() ;MAKE NEW ENTRY IN DATA FILE
+1 ;INPUT : NONE
+2 ;OUTPUT : IFN - Success
+3 ; -1^Error_text - Error
+4 ;
+5 ;DECLARE VARIABLES
+6 NEW DD,DIC,X,DINUM,Y,DLAYGO
+7 SET DIC="^VAT(394.62,"
SET DLAYGO=394.62
+8 SET DIC(0)="L"
+9 ;-- auto numbering - see ^DD(394.62,.01,7.5). It involves $$AUTO^VAQXRF2(2) and file 394.86.
SET X="+"
+10 DO ^DIC
+11 IF Y<0
QUIT "-1^Could not create entry in data file"
+12 QUIT $PIECE(Y,"^",1)
+13 ;
DELDATA(DA) ;DELETE ENTRY IN DATA FILE
+1 ;INPUT : DA - Pointer to VAQ - DATA file
+2 ;OUTPUT : 0 - Success
+3 ; -1^Error_text - Error
+4 ;
+5 ;CHECK INPUT
+6 if ('(+$GET(DA)))
QUIT "-1^Did not pass pointer to data"
+7 ;IF DATA DOES NOT EXIST RETURN SUCCESS
+8 ;Q:('$D(^VAT(394.62,DA))) 0
+9 if ('$DATA(^VAT(394.62,DA)))
QUIT "-1^No Data Exist Record not Deleted"
+10 ;DECLARE VARIABLES
+11 NEW DIK
+12 ;DELETE ENTRY
+13 SET DIK="^VAT(394.62,"
+14 DO ^DIK
+15 if ('$DATA(^VAT(394.62,DA)))
QUIT 0
+16 QUIT "-1^Unable to delete data"
+17 ;
DELSEG(SEG,TRAN) ;DELETE SEGMENT IN DATA FILE FOR A TRANSACTION
+1 ;INPUT : SEG - Segment abbreviation
+2 ; TRAN - Pointer to VAQ - TRANSACTION file
+3 ;OUTPUT : 0 - Success
+4 ; -1^Error_Text - Error
+5 ;
+6 ;CHECK INPUT
+7 if ($GET(SEG)="")
QUIT "-1^Did not pass segment abbreviation"
+8 SET TRAN=+$GET(TRAN)
+9 if (('TRAN)!('$DATA(^VAT(394.61,TRAN))))
QUIT "-1^Did not pass valid transaction"
+10 ;DECLARE VARIABLES
+11 NEW DATAPTR,TMP,SEGPTR
+12 ;GET SEGMENT POINTER
+13 SET SEGPTR=+$ORDER(^VAT(394.71,"C",SEG,""))
+14 if ('SEGPTR)
QUIT "-1^Did not pass valid segment abbreviation"
+15 ;DELETE ENTRIES IN DATA FILE
+16 SET DATAPTR=""
+17 FOR
SET DATAPTR=+$ORDER(^VAT(394.62,"A-SEGMENT",TRAN,SEGPTR,""))
if ('DATAPTR)
QUIT
SET TMP=$$DELDATA(DATAPTR)
+18 QUIT 0
+19 ;
STUBDATA(SEG,TRAN) ;CREATE STUB ENTRY IN DATA FILE
+1 ;INPUT : SEG - Segment abbreviation
+2 ; TRAN - Pointer to VAQ - TRANSACTION file
+3 ;OUTPUT : IFN - Success
+4 ; -1^Error_text - Error
+5 ;NOTES : The following fields (in addition to .01) will be filled in
+6 ; .02 - Segment
+7 ; .05 - Display Ready
+8 ; 40 - Transaction Number
+9 ;
+10 ;CHECK INPUT
+11 if ($GET(SEG)="")
QUIT "-1^Did not pass segment abbreviation"
+12 SET TRAN=+$GET(TRAN)
+13 if (('TRAN)!('$DATA(^VAT(394.61,TRAN))))
QUIT "-1^Did not pass valid transaction"
+14 ;DECLARE VARIABLES
+15 NEW IFN,SEGNAME,TMP,TRANNUM,DIE,DR,Y,DA,DISPLAY
+16 ;GET SEGMENT NAME
+17 SET TMP=+$ORDER(^VAT(394.71,"C",SEG,""))
+18 if ('TMP)
QUIT "-1^Did not pass valid segment abbreviation"
+19 SET TMP=$GET(^VAT(394.71,TMP,0))
+20 SET SEGNAME=$PIECE(TMP,"^",1)
+21 if (SEGNAME="")
QUIT "-1^Could not determine segment name"
+22 ;DETERMINE IF SEGMENT IS DISPLAY READY
+23 SET DISPLAY=+$PIECE(TMP,"^",3)
+24 SET DISPLAY=$SELECT(DISPLAY:"YES",1:"NO")
+25 ;GET TRANSACTION NUMBER
+26 SET TRANNUM=+$GET(^VAT(394.61,TRAN,0))
+27 if ('TRANNUM)
QUIT "-1^Could not determine transaction number"
+28 ;MAKE ENTRY IN DATA FILE
+29 SET IFN=+$$NEWDATA
+30 if (IFN<0)
QUIT "-1^Could not create entry in data file"
+31 ;PLACE INFO IN NEW ENTRY
+32 LOCK +^VAT(394.62,IFN):60
IF ('$TEST)
SET TMP=$$DELDATA(IFN)
QUIT "-1^Could not edit entry (locked by other user)"
+33 ;PLACE SEGMENT NAME INTO DATA
+34 SET DIE="^VAT(394.62,"
+35 SET DA=IFN
+36 SET DR=".02///"_SEGNAME
+37 DO ^DIE
+38 IF ($DATA(Y)#2)
LOCK -^VAT(394.62,IFN)
SET TMP=$$DELDATA(IFN)
QUIT "-1^Could not file segment name"
+39 ;PLACE DISPLAY READY FLAG INTO DATA
+40 SET DIE="^VAT(394.62,"
+41 SET DA=IFN
+42 SET DR=".05///"_DISPLAY
+43 DO ^DIE
+44 IF ($DATA(Y)#2)
LOCK -^VAT(394.62,IFN)
SET TMP=$$DELDATA(IFN)
QUIT "-1^Could not file display ready flag"
+45 ;PLACE TRANSACTION NUBMER INTO DATA
+46 SET DIE="^VAT(394.62,"
+47 SET DA=IFN
+48 SET DR="40///"_TRANNUM
+49 DO ^DIE
+50 IF ($DATA(Y)#2)
LOCK -^VAT(394.62,IFN)
SET TMP=$$DELDATA(IFN)
QUIT "-1^Could not file transaction number"
+51 LOCK -^VAT(394.62,IFN)
+52 QUIT IFN
