PXKMOD ;ISA/KWP -MAIN ROUTINE FOR SAVING MODIFIERS ;10/11/2018
;;1.0;PCE PATIENT CARE ENCOUNTER;**73,121,211**;Aug 12, 1996;Build 454
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(PXKPIEN) ;Add a modifier
N PXKMOD,PXRETVAL,PXKMIEN
S PXKMOD=""
F S PXKMOD=$O(PXKAV(1,PXKMOD)) Q:PXKMOD="" D
.S PXKMIEN=PXKAV(1,PXKMOD)
.;If the modifier is already present do not add it again.
.I $D(^AUPNVCPT(PXKPIEN,1,"B",PXKMIEN)) Q
.S PXRETVAL=$$ADD(PXKPIEN,PXKMIEN)
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 DA,DIC,DO,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",+^TMP("PXK",$J,"VST",1,0,"AFTER")),"^")
I PXKMOD<0 Q 0
S X=PXKMOD
D FILE^DICN
Q 1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXKMOD 1514 printed Oct 16, 2024@18:30:09 Page 2
PXKMOD ;ISA/KWP -MAIN ROUTINE FOR SAVING MODIFIERS ;10/11/2018
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**73,121,211**;Aug 12, 1996;Build 454
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(PXKPIEN) ;Add a modifier
+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 ;If the modifier is already present do not add it again.
+6 IF $DATA(^AUPNVCPT(PXKPIEN,1,"B",PXKMIEN))
QUIT
+7 SET PXRETVAL=$$ADD(PXKPIEN,PXKMIEN)
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 DA,DIC,DO,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",+^TMP("PXK",$JOB,"VST",1,0,"AFTER")),"^")
+7 IF PXKMOD<0
QUIT 0
+8 SET X=PXKMOD
+9 DO FILE^DICN
+10 QUIT 1
