RGP3PST ;BIR/PTD-RG*1*3 PATCH POST-INIT ROUTINE ;02/04/00
;;1.0;CLINICAL INFO RESOURCE NETWORK;**3**;30 Apr 99
MG ;Change mail group for exception 228
N GROUP,DIC,DA,DIE,X,Y,DR,ENT
S DIC="^XMB(3.8,",DIC(0)="XQZ",X="MPIF EXCEPTIONS"
D ^DIC
Q:+Y<0
S GROUP=+Y
S DIC="^RGHL7(991.11,",DIC(0)="XQZ",X=228
D ^DIC
Q:+Y<0
L +^RGHL7(991.11,228):10
S DA=+Y,DIE="^RGHL7(991.11,",DR="6///^S X=GROUP"
D ^DIE
L -^RGHL7(991.11,228)
ACT ;Change action for exception 211
S DIC="^RGHL7(991.11,",DIC(0)="XQZ",X=211
D ^DIC
Q:+Y<0
L +^RGHL7(991.11,211):10
S DA=+Y,DIE="^RGHL7(991.11,",DR="2///MAIL"
D ^DIE
L -^RGHL7(991.11,211)
DEL ;Delete data in action and mail group fields
;for exceptions 209, 213 - 218
F ENT=209,213:1:218 D
.S DIC="^RGHL7(991.11,",DIC(0)="XQZ",X=ENT
.D ^DIC
.Q:+Y<0
.L +^RGHL7(991.11,ENT):10
.S DA=+Y,DIE="^RGHL7(991.11,",DR="2///@;6///@"
.D ^DIE
.L -^RGHL7(991.11,ENT)
K DA,DIC,DIE,DR,ENT,GROUP,X,Y
STAT ;Set EXCEPTION STATUS to 'PROCESSED' for all exceptions
;that go to the MPIF EXCEPTIONS mail group
S DIC="3.8",DIC(0)="Z",X="MPIF EXCEPTIONS" D ^DIC K DIC
S RGMG=$P($G(Y),"^",1) Q:RGMG<1
S IEN=0
F S IEN=$O(^RGHL7(991.1,IEN)) Q:'IEN D
. S IEN2=0,TYP="",MGRP=""
. F S IEN2=$O(^RGHL7(991.1,IEN,1,IEN2)) Q:'IEN2 D
.. S TYP=$P($G(^RGHL7(991.1,IEN,1,IEN2,0)),"^",3) Q:'TYP
.. S MGRP=$P($G(^RGHL7(991.11,TYP,0)),"^",4) Q:MGRP=""
.. I MGRP=RGMG S $P(^RGHL7(991.1,IEN,1,IEN2,0),"^",5)=1
K TYP,MGRP,RGMG,IEN,IEN2
STAT2 ;Set STATUS to PROCESSED for exception types 209,213,214 and
;218 if patient has national ICN
S EXCTYP=""
S HOME=$$SITE^VASITE()
F S EXCTYP=$O(^RGHL7(991.1,"AC",EXCTYP)) Q:'EXCTYP D
. I (EXCTYP=209)!(EXCTYP=213)!(EXCTYP=214)!(EXCTYP=218) D
.. S IEN=0
.. F S IEN=$O(^RGHL7(991.1,"AC",EXCTYP,IEN)) Q:'IEN D
... S IEN2=0,ICN="",RGDFN=""
... F S IEN2=$O(^RGHL7(991.1,"AC",EXCTYP,IEN,IEN2)) Q:'IEN2 D
.... S RGDFN=$P(^RGHL7(991.1,IEN,1,IEN2,0),"^",4) Q:'RGDFN
.... S ICN=+$$GETICN^MPIF001(RGDFN)
.... I $E(ICN,1,3)'=$E($P(HOME,"^",3),1,3)&(ICN>0) D
..... L +^RGHL7(991.1,IEN)
..... S DA(1)=IEN,DA=IEN2,DR="6///"_1,DIE="^RGHL7(991.1,"_DA(1)_",1,"
..... D ^DIE K DIE,DA,DR
..... L -^RGHL7(991.1,IEN)
K EXCTYP,HOME,ICN,IEN,IEN2,RGDFN
Q
INDX ;
K ^RGHL7(991.1,"ASTAT")
S IEN=0
F S IEN=$O(^RGHL7(991.1,IEN)) Q:'IEN D
. S IEN2=0,TYP=""
. F S IEN2=$O(^RGHL7(991.1,IEN,1,IEN2)) Q:'IEN2 D
.. S TYP=$P($G(^RGHL7(991.1,IEN,1,IEN2,0)),"^",3) Q:'TYP
.. I TYP>199 D
... S DA(1)=IEN,DA=IEN2,DIK(1)="6^ASTAT",DIK="^RGHL7(991.1,"_DA(1)_",1,"
... D EN^DIK K DIK,DA
K TYP,IEN,IEN2
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRGP3PST 2638 printed Dec 13, 2024@01:42:34 Page 2
RGP3PST ;BIR/PTD-RG*1*3 PATCH POST-INIT ROUTINE ;02/04/00
+1 ;;1.0;CLINICAL INFO RESOURCE NETWORK;**3**;30 Apr 99
MG ;Change mail group for exception 228
+1 NEW GROUP,DIC,DA,DIE,X,Y,DR,ENT
+2 SET DIC="^XMB(3.8,"
SET DIC(0)="XQZ"
SET X="MPIF EXCEPTIONS"
+3 DO ^DIC
+4 if +Y<0
QUIT
+5 SET GROUP=+Y
+6 SET DIC="^RGHL7(991.11,"
SET DIC(0)="XQZ"
SET X=228
+7 DO ^DIC
+8 if +Y<0
QUIT
+9 LOCK +^RGHL7(991.11,228):10
+10 SET DA=+Y
SET DIE="^RGHL7(991.11,"
SET DR="6///^S X=GROUP"
+11 DO ^DIE
+12 LOCK -^RGHL7(991.11,228)
ACT ;Change action for exception 211
+1 SET DIC="^RGHL7(991.11,"
SET DIC(0)="XQZ"
SET X=211
+2 DO ^DIC
+3 if +Y<0
QUIT
+4 LOCK +^RGHL7(991.11,211):10
+5 SET DA=+Y
SET DIE="^RGHL7(991.11,"
SET DR="2///MAIL"
+6 DO ^DIE
+7 LOCK -^RGHL7(991.11,211)
DEL ;Delete data in action and mail group fields
+1 ;for exceptions 209, 213 - 218
+2 FOR ENT=209,213:1:218
Begin DoDot:1
+3 SET DIC="^RGHL7(991.11,"
SET DIC(0)="XQZ"
SET X=ENT
+4 DO ^DIC
+5 if +Y<0
QUIT
+6 LOCK +^RGHL7(991.11,ENT):10
+7 SET DA=+Y
SET DIE="^RGHL7(991.11,"
SET DR="2///@;6///@"
+8 DO ^DIE
+9 LOCK -^RGHL7(991.11,ENT)
End DoDot:1
+10 KILL DA,DIC,DIE,DR,ENT,GROUP,X,Y
STAT ;Set EXCEPTION STATUS to 'PROCESSED' for all exceptions
+1 ;that go to the MPIF EXCEPTIONS mail group
+2 SET DIC="3.8"
SET DIC(0)="Z"
SET X="MPIF EXCEPTIONS"
DO ^DIC
KILL DIC
+3 SET RGMG=$PIECE($GET(Y),"^",1)
if RGMG<1
QUIT
+4 SET IEN=0
+5 FOR
SET IEN=$ORDER(^RGHL7(991.1,IEN))
if 'IEN
QUIT
Begin DoDot:1
+6 SET IEN2=0
SET TYP=""
SET MGRP=""
+7 FOR
SET IEN2=$ORDER(^RGHL7(991.1,IEN,1,IEN2))
if 'IEN2
QUIT
Begin DoDot:2
+8 SET TYP=$PIECE($GET(^RGHL7(991.1,IEN,1,IEN2,0)),"^",3)
if 'TYP
QUIT
+9 SET MGRP=$PIECE($GET(^RGHL7(991.11,TYP,0)),"^",4)
if MGRP=""
QUIT
+10 IF MGRP=RGMG
SET $PIECE(^RGHL7(991.1,IEN,1,IEN2,0),"^",5)=1
End DoDot:2
End DoDot:1
+11 KILL TYP,MGRP,RGMG,IEN,IEN2
STAT2 ;Set STATUS to PROCESSED for exception types 209,213,214 and
+1 ;218 if patient has national ICN
+2 SET EXCTYP=""
+3 SET HOME=$$SITE^VASITE()
+4 FOR
SET EXCTYP=$ORDER(^RGHL7(991.1,"AC",EXCTYP))
if 'EXCTYP
QUIT
Begin DoDot:1
+5 IF (EXCTYP=209)!(EXCTYP=213)!(EXCTYP=214)!(EXCTYP=218)
Begin DoDot:2
+6 SET IEN=0
+7 FOR
SET IEN=$ORDER(^RGHL7(991.1,"AC",EXCTYP,IEN))
if 'IEN
QUIT
Begin DoDot:3
+8 SET IEN2=0
SET ICN=""
SET RGDFN=""
+9 FOR
SET IEN2=$ORDER(^RGHL7(991.1,"AC",EXCTYP,IEN,IEN2))
if 'IEN2
QUIT
Begin DoDot:4
+10 SET RGDFN=$PIECE(^RGHL7(991.1,IEN,1,IEN2,0),"^",4)
if 'RGDFN
QUIT
+11 SET ICN=+$$GETICN^MPIF001(RGDFN)
+12 IF $EXTRACT(ICN,1,3)'=$EXTRACT($PIECE(HOME,"^",3),1,3)&(ICN>0)
Begin DoDot:5
+13 LOCK +^RGHL7(991.1,IEN)
+14 SET DA(1)=IEN
SET DA=IEN2
SET DR="6///"_1
SET DIE="^RGHL7(991.1,"_DA(1)_",1,"
+15 DO ^DIE
KILL DIE,DA,DR
+16 LOCK -^RGHL7(991.1,IEN)
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+17 KILL EXCTYP,HOME,ICN,IEN,IEN2,RGDFN
+18 QUIT
INDX ;
+1 KILL ^RGHL7(991.1,"ASTAT")
+2 SET IEN=0
+3 FOR
SET IEN=$ORDER(^RGHL7(991.1,IEN))
if 'IEN
QUIT
Begin DoDot:1
+4 SET IEN2=0
SET TYP=""
+5 FOR
SET IEN2=$ORDER(^RGHL7(991.1,IEN,1,IEN2))
if 'IEN2
QUIT
Begin DoDot:2
+6 SET TYP=$PIECE($GET(^RGHL7(991.1,IEN,1,IEN2,0)),"^",3)
if 'TYP
QUIT
+7 IF TYP>199
Begin DoDot:3
+8 SET DA(1)=IEN
SET DA=IEN2
SET DIK(1)="6^ASTAT"
SET DIK="^RGHL7(991.1,"_DA(1)_",1,"
+9 DO EN^DIK
KILL DIK,DA
End DoDot:3
End DoDot:2
End DoDot:1
+10 KILL TYP,IEN,IEN2
+11 QUIT
+12 ;
