| [613] | 1 | VAQPST03 ;ALB/JFP - PDX, POST INIT ROUTINE ;01JUN93
|
|---|
| 2 | ;;1.5;PATIENT DATA EXCHANGE;**1**;NOV 17, 1993
|
|---|
| 3 | SEG ; -- Initialization of VAQ - Segment Group file 394.84
|
|---|
| 4 | W !!,"Initialization of VAQ - Segment Group File...",!
|
|---|
| 5 | I '$D(^VAT(394.84)) W !,"Error...VAQ - Segment Group file missing, post init halted" S POP=1 QUIT
|
|---|
| 6 | D ALL^VAQPST04
|
|---|
| 7 | D COP^VAQPST04
|
|---|
| 8 | W !!,"Add/Edit/Delete entries in VAQ - Segment Group File",!
|
|---|
| 9 | F D S1 Q:EXIT=-1
|
|---|
| 10 | W !!," ** Initialization of VAQ - Segment Group File complete"
|
|---|
| 11 | K EXIT,Y
|
|---|
| 12 | QUIT
|
|---|
| 13 | S1 ; -- Prompt entry
|
|---|
| 14 | W !
|
|---|
| 15 | S DIC="^VAT(394.84,",DIC(0)="ALQ",DIC("DR")="[VAQ EDIT FILE]"
|
|---|
| 16 | S DLAYGO=394.84
|
|---|
| 17 | D ^DIC K DIC,DLAYGO
|
|---|
| 18 | S EXIT=$P(Y,U,1)
|
|---|
| 19 | I Y=-1 QUIT
|
|---|
| 20 | I $P(Y,U,3)=1 QUIT
|
|---|
| 21 | ; -- Update existing entry
|
|---|
| 22 | S DIE="^VAT(394.84,",DA=$P(Y,U,1),DR="[VAQ EDIT FILE]"
|
|---|
| 23 | D ^DIE K DIE,DA,DR
|
|---|
| 24 | I $D(Y) S EXIT=-1
|
|---|
| 25 | QUIT
|
|---|
| 26 | ;
|
|---|
| 27 | OUT ; -- Initialization of VAQ - Outgoing Group file 394.83
|
|---|
| 28 | W !!,"Initialization of VAQ - Outgoing Group File... (add/edit/delete) ",!
|
|---|
| 29 | I '$D(^VAT(394.83)) W !,"Error...VAQ - Outgoing Group file missing, post init halted" S POP=1 QUIT
|
|---|
| 30 | F D O1 Q:EXIT=-1
|
|---|
| 31 | W !!," ** Initialization of VAQ - Outgoing Group File complete"
|
|---|
| 32 | K EXIT,Y
|
|---|
| 33 | QUIT
|
|---|
| 34 | O1 ; -- Prompt entry
|
|---|
| 35 | W !
|
|---|
| 36 | S DIC="^VAT(394.83,",DIC(0)="ALQ",DIC("DR")="[VAQ EDIT FILE]"
|
|---|
| 37 | S DLAYGO=394.83
|
|---|
| 38 | D ^DIC K DIC,DLAYGO
|
|---|
| 39 | S EXIT=$P(Y,U,1)
|
|---|
| 40 | I Y=-1 QUIT
|
|---|
| 41 | I $P(Y,U,3)=1 QUIT
|
|---|
| 42 | ; -- Update existing entry
|
|---|
| 43 | S DIE="^VAT(394.83,",DA=$P(Y,U,1),DR="[VAQ EDIT FILE]"
|
|---|
| 44 | D ^DIE K DIE,DA,DR
|
|---|
| 45 | I $D(Y) S EXIT=-1
|
|---|
| 46 | QUIT
|
|---|
| 47 | ;
|
|---|
| 48 | REL ; -- Initialization of VAQ - Release Group file 394.82
|
|---|
| 49 | W !!,"Initialization of VAQ - Release Group File... ",!
|
|---|
| 50 | I '$D(^VAT(394.82)) W !,"Error...VAQ -Release Group file missing, post init halted" S POP=1 QUIT
|
|---|
| 51 | D COPV1
|
|---|
| 52 | W !,"Add/Edit/Delete entries in VAQ - Release Group"
|
|---|
| 53 | F D R1 Q:EXIT=-1
|
|---|
| 54 | W !!," ** Initialization of VAQ - Release Group File complete"
|
|---|
| 55 | K EXIT,Y
|
|---|
| 56 | QUIT
|
|---|
| 57 | R1 ; -- Prompt entry
|
|---|
| 58 | W !
|
|---|
| 59 | S DIC="^VAT(394.82,",DIC(0)="ALQ",DIC("DR")="[VAQ EDIT FILE]"
|
|---|
| 60 | S DLAYGO=394.82
|
|---|
| 61 | D ^DIC K DIC,DLAYGO
|
|---|
| 62 | S EXIT=$P(Y,U,1)
|
|---|
| 63 | I Y=-1 QUIT
|
|---|
| 64 | I $P(Y,U,3)=1 QUIT
|
|---|
| 65 | ; -- Update existing entry
|
|---|
| 66 | S DIE="^VAT(394.82,",DA=$P(Y,U,1),DR="[VAQ EDIT FILE]"
|
|---|
| 67 | D ^DIE K DIE,DA,DR
|
|---|
| 68 | I $D(Y) S EXIT=-1
|
|---|
| 69 | QUIT
|
|---|
| 70 | ;
|
|---|
| 71 | ENCR ; -- Initialization of VAQ - Encrypted Fields File 394.73
|
|---|
| 72 | W !!,"Initialization of VAQ - Encrypted Fields File... (add/edit/delete) ",!
|
|---|
| 73 | I '$D(^VAT(394.73)) W !,"Error...VAQ - Encrypted fields file missing, post init halted" S POP=1 QUIT
|
|---|
| 74 | F D E1 Q:EXIT=-1
|
|---|
| 75 | W !!," ** Initialization of VAQ - Encrypted Fields File complete"
|
|---|
| 76 | K EXIT,Y
|
|---|
| 77 | QUIT
|
|---|
| 78 | E1 ; -- Prompt entry
|
|---|
| 79 | W !
|
|---|
| 80 | S DIC="^VAT(394.73,",DIC(0)="ALQ",DIC("DR")="[VAQ EDIT FILE]"
|
|---|
| 81 | S DLAYGO=394.73
|
|---|
| 82 | D ^DIC K DIC,DLAYGO
|
|---|
| 83 | S EXIT=$P(Y,U,1)
|
|---|
| 84 | I Y=-1 QUIT
|
|---|
| 85 | I $P(Y,U,3)=1 QUIT
|
|---|
| 86 | ; -- Update existing entry
|
|---|
| 87 | S DIE="^VAT(394.73,",DA=$P(Y,U,1),DR="[VAQ EDIT FILE]"
|
|---|
| 88 | D ^DIE K DIE,DA,DR
|
|---|
| 89 | I $D(Y) S EXIT=-1
|
|---|
| 90 | QUIT
|
|---|
| 91 | ;
|
|---|
| 92 | COPV1 ; -- Copies multiple in V1.0 PDX parameter file to release group file
|
|---|
| 93 | W !," Updating VAQ - Release Group file from version 1.0",!
|
|---|
| 94 | I '$D(^VAT(394.2)) W !," ** Unable to update...version 1.0 file missing. Requires Manual entry" QUIT
|
|---|
| 95 | N ENTRY,ND,INSTPT,INST,DOMPT,DOM
|
|---|
| 96 | S ENTRY=""
|
|---|
| 97 | F S ENTRY=$O(^VAT(394.2,1,1,ENTRY)) Q:ENTRY="" D V2
|
|---|
| 98 | W !!,"Update from version 1 completed",!
|
|---|
| 99 | QUIT
|
|---|
| 100 | V2 ; --
|
|---|
| 101 | S ND=$G(^VAT(394.2,1,1,ENTRY,0))
|
|---|
| 102 | S INSTPT=$P(ND,U,1),DOMPT=$P(ND,U,2)
|
|---|
| 103 | Q:INSTPT=""
|
|---|
| 104 | Q:DOMPT=""
|
|---|
| 105 | Q:'$D(^DIC(4,INSTPT,0))
|
|---|
| 106 | S INST=$P(^DIC(4,INSTPT,0),U,1)
|
|---|
| 107 | Q:'$D(^DIC(4.2,DOMPT,0))
|
|---|
| 108 | S DOM=$P(^DIC(4.2,DOMPT,0),U,1)
|
|---|
| 109 | ; -- update file
|
|---|
| 110 | S DIC="^VAT(394.82,",DIC(0)="L",DLAYGO=394.82,X=INST
|
|---|
| 111 | S DIC("DR")=".02///"_DOM
|
|---|
| 112 | D ^DIC K DIC,X,DLAYGO
|
|---|
| 113 | I Y=-1 W !," * Unable to add ",INST," to VAQ - Release Group File"
|
|---|
| 114 | W !," ",INST," added"
|
|---|
| 115 | QUIT
|
|---|
| 116 | END ; -- End of code
|
|---|
| 117 | QUIT
|
|---|
