- 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 Feb 18, 2025@23:51:57 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
