1 | VAQPST04 ;ALB/JFP - PDX, POST INIT ROUTINE ;01JUN93
|
---|
2 | ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
|
---|
3 | ALL ; --Creates an entry in the Segment Group file 394.84 of all segments
|
---|
4 | I '$D(^VAT(394.71)) QUIT
|
---|
5 | ;IF IT'S ALREADY THERE, DELETE IT
|
---|
6 | S DA=""
|
---|
7 | F S DA=+$O(^VAT(394.84,"B","ALL",DA)) Q:('DA) D
|
---|
8 | .Q:($P(^VAT(394.84,DA,0),"^",2)=0)
|
---|
9 | .S DIK="^VAT(394.84,"
|
---|
10 | .D ^DIK K DIK
|
---|
11 | W !," Creating a segment group called ""ALL"" "
|
---|
12 | W !," This group will contain all data segments"
|
---|
13 | S DIC="^VAT(394.84,",DIC(0)="L",DLAYGO=394.84,X="ALL"
|
---|
14 | S DIC("DR")=".02///PUBLIC" ; -- Public
|
---|
15 | K DD,DO
|
---|
16 | D FILE^DICN K DIC,DLAYGO,X,DINUM
|
---|
17 | I Y=-1 QUIT
|
---|
18 | ; -- Add segments
|
---|
19 | S DA=$P(Y,U,1),DIE="^VAT(394.84,",SEG=""
|
---|
20 | F S SEG=$O(^VAT(394.71,"B",SEG)) Q:SEG="" D S1
|
---|
21 | W !,"Done"
|
---|
22 | K SEG,DA,DIE
|
---|
23 | QUIT
|
---|
24 | S1 ; -- Update existing entry
|
---|
25 | W !," ",SEG," - added"
|
---|
26 | S DR="10///"_SEG
|
---|
27 | S DR(2,394.841)=".01///"_SEG
|
---|
28 | D ^DIE K DR
|
---|
29 | QUIT
|
---|
30 | ;
|
---|
31 | ;
|
---|
32 | COP ; -- Creates entries in Segment group file from Health Summary Type file^GMT(142,
|
---|
33 | N TMP
|
---|
34 | I '$D(^GMT(142)) QUIT
|
---|
35 | S DIR(0)="Y",DIR("B")="NO"
|
---|
36 | S DIR("A")="Create entries in Segment Groups from Health Summary Type File"
|
---|
37 | D ^DIR K DIR
|
---|
38 | I ('Y)!($D(DUOUT))!($D(DTOUT)) QUIT
|
---|
39 | ;
|
---|
40 | S GRP=""
|
---|
41 | F S GRP=$O(^GMT(142,"B",GRP)) Q:GRP="" D G1
|
---|
42 | QUIT
|
---|
43 | ;
|
---|
44 | G1 ;
|
---|
45 | ;IF IT'S ALREADY THERE, DELETE IT
|
---|
46 | S DA=""
|
---|
47 | F S DA=+$O(^VAT(394.84,"B",GRP,DA)) Q:('DA) D
|
---|
48 | .Q:($P(^VAT(394.84,DA,0),"^",2)=0)
|
---|
49 | .S DIK="^VAT(394.84,"
|
---|
50 | .D ^DIK K DIK
|
---|
51 | Q:(GRP="GMTS HS ADHOC OPTION")
|
---|
52 | S ENTRY="",ENTRY=$O(^GMT(142,"B",GRP,ENTRY))
|
---|
53 | S DIC="^VAT(394.84,",DIC(0)="L",DLAYGO=394.84,X=GRP
|
---|
54 | S DIC("DR")=".02///PUBLIC" ; -- Public
|
---|
55 | K DD,DO
|
---|
56 | D FILE^DICN K DIC,DLAYGO,X,DINUM
|
---|
57 | I Y=-1 QUIT
|
---|
58 | ; -- Set components within entry
|
---|
59 | W !!,?3,GRP," <-- Segment group added, the list of components follows"
|
---|
60 | S DA=$P(Y,U,1),DIE="^VAT(394.84,",SEGPT=""
|
---|
61 | F S SEGPT=$O(^GMT(142,ENTRY,1,"C",SEGPT)) Q:SEGPT="" D S0
|
---|
62 | K SEG,DA,DIE
|
---|
63 | QUIT
|
---|
64 | ;
|
---|
65 | S0 ;
|
---|
66 | S SEG=$P($G(^GMT(142.1,SEGPT,0)),U,4)
|
---|
67 | S SEGNM=$P($G(^GMT(142.1,SEGPT,0)),U,1)
|
---|
68 | ;FILTER OUT NON-SUPPORTED COMPONENTS
|
---|
69 | I ((SEG'="")&($D(^VAT(394.71,"C",SEG)))) D S2
|
---|
70 | QUIT
|
---|
71 | ;
|
---|
72 | S2 ; -- Update existing entry
|
---|
73 | W !,?10,SEG
|
---|
74 | S DR="10///"_SEG
|
---|
75 | S DR(2,394.841)=".01///"_SEG
|
---|
76 | ;DETERMINE IF TIME & OCCURRENCE LIMITS ARE APPLICABLE
|
---|
77 | S TMP=$$LIMITS^VAQDBIH3(SEGPT)
|
---|
78 | ;PUT TIME LIMIT OF 1 YEAR (IF APPLICABLE)
|
---|
79 | S:($P(TMP,"^",1)) DR(2,394.841)=DR(2,394.841)_";.04///1Y"
|
---|
80 | ;PUT OCCURRENCE LIMIT OF 10 (IF APPLICABLE)
|
---|
81 | S:($P(TMP,"^",2)) DR(2,394.841)=DR(2,394.841)_";.05///10"
|
---|
82 | D ^DIE K DR
|
---|
83 | W ?16," - ",SEGNM
|
---|
84 | QUIT
|
---|
85 | ;
|
---|
86 | END ; -- End of code
|
---|
87 | QUIT
|
---|