1 | PXKMOD ;ISA/KWP -MAIN ROUTINE FOR SAVING MODIFIERS ;9/11/98
|
---|
2 | ;;1.0;PCE PATIENT CARE ENCOUNTER;**73,121**;Aug 12, 1996
|
---|
3 | SUBSCR ;
|
---|
4 | AFTER N PXKMOD
|
---|
5 | S PXKMOD=""
|
---|
6 | F S PXKMOD=$O(@PXKREF@(PXKCAT,PXKSEQ,PXKSUB,PXKMOD)) Q:'PXKMOD D
|
---|
7 | . S PXKAFT(1,PXKMOD)=$G(@PXKREF@(PXKCAT,PXKSEQ,PXKSUB,PXKMOD,"AFTER"))
|
---|
8 | BEFORE S PXKMOD=""
|
---|
9 | F S PXKMOD=$O(@PXKREF@(PXKCAT,PXKSEQ,PXKSUB,PXKMOD)) Q:'PXKMOD D
|
---|
10 | . S PXKBEF(1,PXKMOD)=$G(@PXKREF@(PXKCAT,PXKSEQ,PXKSUB,PXKMOD,"BEFORE"))
|
---|
11 | Q
|
---|
12 | UPD ;
|
---|
13 | N PXKMOD,PXRETVAL,PXKMIEN
|
---|
14 | S PXKMOD=""
|
---|
15 | F S PXKMOD=$O(PXKAV(1,PXKMOD)) Q:PXKMOD="" D
|
---|
16 | .S PXKMIEN=PXKAV(1,PXKMOD)
|
---|
17 | .L +@PXKLR:10
|
---|
18 | .S PXRETVAL=$$ADD(PXKPIEN,PXKMIEN)
|
---|
19 | .L -@PXKLR
|
---|
20 | Q
|
---|
21 | LOOP N PXKMOD
|
---|
22 | S PXKMOD=""
|
---|
23 | F S PXKMOD=$O(PXKAFT(1,PXKMOD)) Q:PXKMOD="" D
|
---|
24 | . Q:PXKAFT(1,PXKMOD)=""
|
---|
25 | . S PXKAV(1,PXKMOD)=PXKAFT(1,PXKMOD)
|
---|
26 | S PXKMOD=""
|
---|
27 | F S PXKMOD=$O(PXKBEF(1,PXKMOD)) Q:PXKMOD="" D
|
---|
28 | . Q:PXKBEF(1,PXKMOD)=""
|
---|
29 | . S PXKBV(1,PXKMOD)=PXKBEF(1,PXKMOD)
|
---|
30 | Q
|
---|
31 | DELETE(IEN) ;
|
---|
32 | N DIE,DR,SIEN,DA
|
---|
33 | S DIE="^AUPNVCPT("_IEN_",1,",DR=".01////@",SIEN=0
|
---|
34 | F S SIEN=$O(^AUPNVCPT(IEN,1,SIEN)) Q:SIEN="" S DA=SIEN,DA(1)=IEN D ^DIE
|
---|
35 | Q 1
|
---|
36 | ADD(IEN,PXKMOD) ;
|
---|
37 | N DIC,DA,X
|
---|
38 | S DIC="^AUPNVCPT("_IEN_",1,"
|
---|
39 | S DIC("P")=$P($G(^DD(+$P($G(^AUPNVCPT(0)),"^",2),1,0)),"^",2)
|
---|
40 | S DA(1)=IEN
|
---|
41 | S DIC(0)="L"
|
---|
42 | ;S PXKMOD=$P($$MOD^ICPTMOD(PXKMOD,"I"),"^")
|
---|
43 | S PXKMOD=$P($$MOD^ICPTMOD(PXKMOD,"I",+^TMP("PXK",$J,"VST",1,0,"AFTER")),"^")
|
---|
44 | I PXKMOD<0 Q 0
|
---|
45 | S X=PXKMOD
|
---|
46 | D FILE^DICN
|
---|
47 | Q 1
|
---|