| 1 | VAQPST02 ;ALB/JFP - PDX, POST INIT ROUTINE ;01JUN93
|
|---|
| 2 | ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
|
|---|
| 3 | PARM ; -- Initialization of VAQ Parameter file 394.81
|
|---|
| 4 | N CNT,FILENO,FILE,ENTRY
|
|---|
| 5 | W !!,"Initialization of VAQ - Parameter file",!
|
|---|
| 6 | I '$D(^VAT(394.81)) W !,"Error...VAQ - Parameter file missing, post init halted" S POP=1 QUIT
|
|---|
| 7 | P1 S FILENO=394.81,FILE="^VAT(394.81,"
|
|---|
| 8 | S ENTRY=0,ENTRY=$O(^VAT(394.81,ENTRY))
|
|---|
| 9 | I ENTRY="" D P2 QUIT
|
|---|
| 10 | I $D(^VAT(394.81,ENTRY)) D MISSING^VAQPST01,PROMPT^VAQPST01,PEXIT QUIT
|
|---|
| 11 | P2 S ENTRY=+$O(^VAT(394.2,0))
|
|---|
| 12 | I ENTRY>0 D COPV1 Q:CNT=0 D P1 QUIT
|
|---|
| 13 | ; -- Add entry
|
|---|
| 14 | S DIC="^VAT(394.81,"
|
|---|
| 15 | S DIC(0)="L"
|
|---|
| 16 | S DIC("DR")=".02;10;20;21;30;31"
|
|---|
| 17 | S X=+$$SITE^VASITE()
|
|---|
| 18 | S DLAYGO=394.81
|
|---|
| 19 | K DD,DO
|
|---|
| 20 | D FILE^DICN K DIC,DLAYGO,X
|
|---|
| 21 | I Y<0 W !,"Error...Could not make an entry on VAQ - Parameter file" S POP=1 QUIT
|
|---|
| 22 | W !!," ** Initialization of VAQ - Parameter file complete"
|
|---|
| 23 | D PEXIT
|
|---|
| 24 | QUIT
|
|---|
| 25 | ;
|
|---|
| 26 | COPV1 ; -- Copy version 1 fields to version 1.5
|
|---|
| 27 | S CNT=0
|
|---|
| 28 | S ND=$G(^VAT(394.2,ENTRY,0))
|
|---|
| 29 | S FAC=$P(ND,U,5) I FAC="" S CNT=CNT+1 QUIT
|
|---|
| 30 | S LFDATA=$P(ND,U,3) I LFDATA="" S CNT=CNT+1
|
|---|
| 31 | S DOM=$P(ND,U,4) I DOM="" S CNT=CNT+1
|
|---|
| 32 | S DIC="^VAT(394.81,"
|
|---|
| 33 | S DIC(0)="L"
|
|---|
| 34 | ;S DIC("DR")=".02////"_DOM_";10///"_LFDATA_";20///NO;21///Kernal-Hasing"
|
|---|
| 35 | S DIC("DR")=".02////"_DOM_";10///"_LFDATA_";20///NO;21///Kernel Hashing"
|
|---|
| 36 | S X=FAC
|
|---|
| 37 | S DLAYGO=394.81
|
|---|
| 38 | K DD,DO
|
|---|
| 39 | D FILE^DICN K DIC,DLAYGO,X
|
|---|
| 40 | I Y<0 W !,"Error...Could not make an entry on VAQ - Parameter file" S POP=1 QUIT
|
|---|
| 41 | W !!," ** Initialization of VAQ - Parameter file complete"
|
|---|
| 42 | D PEXIT
|
|---|
| 43 | QUIT
|
|---|
| 44 | ;
|
|---|
| 45 | PEXIT ; -- Clean up variables
|
|---|
| 46 | K FILNO,FILE,ENTRY
|
|---|
| 47 | K ND,FAC,DOM,LFDATA
|
|---|
| 48 | QUIT
|
|---|
| 49 | ;
|
|---|
| 50 | AUTO ; -- Initialization of VAQ - Auto-numbering file 394.86
|
|---|
| 51 | W !!,"Initialization of VAQ - Auto-numbering file",!
|
|---|
| 52 | I '$D(^VAT(394.86)) W !,"Error...VAQ - Auto-numbering file missing, post init halted" S POP=1 QUIT
|
|---|
| 53 | S FILENO=394.86,FILE="^VAT(394.86,"
|
|---|
| 54 | S ENTRY=0 S ENTRY=$O(^VAT(394.86,ENTRY))
|
|---|
| 55 | I ENTRY="" D A1 QUIT
|
|---|
| 56 | I $D(^VAT(394.86,ENTRY)) D MISSING^VAQPST01,PROMPT^VAQPST01 QUIT
|
|---|
| 57 | A1 ; -- Add entry
|
|---|
| 58 | S DIC="^VAT(394.86,"
|
|---|
| 59 | S DIC(0)="L"
|
|---|
| 60 | S DIC("DR")="10///100;20///0;30///0"
|
|---|
| 61 | S X=1
|
|---|
| 62 | S DINUM=1
|
|---|
| 63 | S DLAYGO=394.86
|
|---|
| 64 | K DD,DO
|
|---|
| 65 | D FILE^DICN K DIC,DLAYGO,DINUM,X
|
|---|
| 66 | I Y<0 W !,"Error...Could not make an entry on VAQ - Auto-numbering file" S POP=1 QUIT
|
|---|
| 67 | W !!," ** Initialization of VAQ - Auto-numbering file complete"
|
|---|
| 68 | K FILENO,FILE,ENTRY
|
|---|
| 69 | QUIT
|
|---|
| 70 | END ; -- End of code
|
|---|
| 71 | QUIT
|
|---|
