PXKMOD.m

PXKMOD ;ISA/KWP -MAIN ROUTINE FOR SAVING MODIFIERS ;9/11/98

 ;;1.0;PCE PATIENT CARE ENCOUNTER;**73**;Aug 12, 1996

SUBSCR ;

AFTER N PXKMOD

 S PXKMOD=""

 F  S PXKMOD=$O(@PXKREF@(PXKCAT,PXKSEQ,PXKSUB,PXKMOD)) Q:'PXKMOD  D

 . S PXKAFT(1,PXKMOD)=$G(@PXKREF@(PXKCAT,PXKSEQ,PXKSUB,PXKMOD,"AFTER"))

BEFORE S PXKMOD=""

 F  S PXKMOD=$O(@PXKREF@(PXKCAT,PXKSEQ,PXKSUB,PXKMOD)) Q:'PXKMOD  D

 . S PXKBEF(1,PXKMOD)=$G(@PXKREF@(PXKCAT,PXKSEQ,PXKSUB,PXKMOD,"BEFORE"))

 Q

UPD ;

 N PXKMOD,PXRETVAL,PXKMIEN

 S PXKMOD=""

 F  S PXKMOD=$O(PXKAV(1,PXKMOD)) Q:PXKMOD=""  D

 .S PXKMIEN=PXKAV(1,PXKMOD)

 .L +@PXKLR:10

 .S PXRETVAL=$$ADD(PXKPIEN,PXKMIEN)

 .L -@PXKLR

 Q

LOOP N PXKMOD

 S PXKMOD=""

 F  S PXKMOD=$O(PXKAFT(1,PXKMOD)) Q:PXKMOD=""  D

 . Q:PXKAFT(1,PXKMOD)=""

 . S PXKAV(1,PXKMOD)=PXKAFT(1,PXKMOD)

 S PXKMOD=""

 F  S PXKMOD=$O(PXKBEF(1,PXKMOD)) Q:PXKMOD=""  D

 . Q:PXKBEF(1,PXKMOD)=""

 . S PXKBV(1,PXKMOD)=PXKBEF(1,PXKMOD)

 Q

DELETE(IEN) ;

 N DIE,DR,SIEN,DA

 S DIE="^AUPNVCPT("_IEN_",1,",DR=".01////@",SIEN=0

 F  S SIEN=$O(^AUPNVCPT(IEN,1,SIEN)) Q:SIEN=""  S DA=SIEN,DA(1)=IEN D ^DIE

 Q 1

ADD(IEN,PXKMOD) ;

 N DIC,DA,X

 S DIC="^AUPNVCPT("_IEN_",1,"

 S DIC("P")=$P($G(^DD(+$P($G(^AUPNVCPT(0)),"^",2),1,0)),"^",2)

 S DA(1)=IEN

 S DIC(0)="L"

 S PXKMOD=$P($$MOD^ICPTMOD(PXKMOD,"I"),"^")

 I PXKMOD<0 Q 0

 S X=PXKMOD

 D FILE^DICN

 Q 1

PXKMOD    ;ISA/KWP -MAIN ROUTINE FOR SAVING MODIFIERS ;9/11/98

 +1       ;;1.0;PCE PATIENT CARE ENCOUNTER;**73**;Aug 12, 1996

SUBSCR    ;

AFTER      NEW PXKMOD

 +1        SET PXKMOD=""

 +2        FOR 

               SET PXKMOD=$ORDER(@PXKREF@(PXKCAT,PXKSEQ,PXKSUB,PXKMOD))

               IF 'PXKMOD

                   QUIT 

               Begin DoDot:1

 +3                SET PXKAFT(1,PXKMOD)=$GET(@PXKREF@(PXKCAT,PXKSEQ,PXKSUB,PXKMOD,"AFTER"))

               End DoDot:1

BEFORE     SET PXKMOD=""

 +1        FOR 

               SET PXKMOD=$ORDER(@PXKREF@(PXKCAT,PXKSEQ,PXKSUB,PXKMOD))

               IF 'PXKMOD

                   QUIT 

               Begin DoDot:1

 +2                SET PXKBEF(1,PXKMOD)=$GET(@PXKREF@(PXKCAT,PXKSEQ,PXKSUB,PXKMOD,"BEFORE"))

               End DoDot:1

 +3        QUIT 

UPD       ;

 +1        NEW PXKMOD,PXRETVAL,PXKMIEN

 +2        SET PXKMOD=""

 +3        FOR 

               SET PXKMOD=$ORDER(PXKAV(1,PXKMOD))

               IF PXKMOD=""

                   QUIT 

               Begin DoDot:1

 +4                SET PXKMIEN=PXKAV(1,PXKMOD)

 +5                LOCK +@PXKLR:10

 +6                SET PXRETVAL=$$ADD(PXKPIEN,PXKMIEN)

 +7                LOCK -@PXKLR

               End DoDot:1

 +8        QUIT 

LOOP       NEW PXKMOD

 +1        SET PXKMOD=""

 +2        FOR 

               SET PXKMOD=$ORDER(PXKAFT(1,PXKMOD))

               IF PXKMOD=""

                   QUIT 

               Begin DoDot:1

 +3                IF PXKAFT(1,PXKMOD)=""

                       QUIT 

 +4                SET PXKAV(1,PXKMOD)=PXKAFT(1,PXKMOD)

               End DoDot:1

 +5        SET PXKMOD=""

 +6        FOR 

               SET PXKMOD=$ORDER(PXKBEF(1,PXKMOD))

               IF PXKMOD=""

                   QUIT 

               Begin DoDot:1

 +7                IF PXKBEF(1,PXKMOD)=""

                       QUIT 

 +8                SET PXKBV(1,PXKMOD)=PXKBEF(1,PXKMOD)

               End DoDot:1

 +9        QUIT 

DELETE(IEN) ;

 +1        NEW DIE,DR,SIEN,DA

 +2        SET DIE="^AUPNVCPT("_IEN_",1,"

           SET DR=".01////@"

           SET SIEN=0

 +3        FOR 

               SET SIEN=$ORDER(^AUPNVCPT(IEN,1,SIEN))

               IF SIEN=""

                   QUIT 

               SET DA=SIEN

               SET DA(1)=IEN

               DO ^DIE

 +4        QUIT 1

ADD(IEN,PXKMOD) ;

 +1        NEW DIC,DA,X

 +2        SET DIC="^AUPNVCPT("_IEN_",1,"

 +3        SET DIC("P")=$PIECE($GET(^DD(+$PIECE($GET(^AUPNVCPT(0)),"^",2),1,0)),"^",2)

 +4        SET DA(1)=IEN

 +5        SET DIC(0)="L"

 +6        SET PXKMOD=$PIECE($$MOD^ICPTMOD(PXKMOD,"I"),"^")

 +7        IF PXKMOD<0

               QUIT 0

 +8        SET X=PXKMOD

 +9        DO FILE^DICN

 +10       QUIT 1