source: WorldVistAEHR/trunk/r/PCE_PATIENT_CARE_ENCOUNTER-AUTN-EFDP-PX-VSIT--PXRM/PXKMOD.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.4 KB
RevLine 
[613]1PXKMOD ;ISA/KWP -MAIN ROUTINE FOR SAVING MODIFIERS ;9/11/98
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**73,121**;Aug 12, 1996
3SUBSCR ;
4AFTER 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"))
8BEFORE 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
12UPD ;
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
21LOOP 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
31DELETE(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
36ADD(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
Note: See TracBrowser for help on using the repository browser.