PXXDPT ;ISL/DLT - Synchronize Patient File (2) and IHS Patient File (#9000001) ;05/15/2018
;;1.0;PCE PATIENT CARE ENCOUNTER;**1,211**;Aug 12, 1996;Build 454
;;1.0;PCE Patient/IHS Subset;;Nov 01, 1994
;
SETSSN ; Entry Point from PX09 cross-reference on File 2, field .09
;to define patient entry in 9000001.
D CHECK Q:'$T
EN Q:PX=""
;DA is the DFN and PX is the SSN.
;If the patient entry already exists quit.
I $D(^AUPNPAT(DA,0)) Q
N FDA,FDAIEN,MSG,PXXLOC
S PXXLOC=+$P($G(^PX(815,1,"PXPT")),"^",1)
I PXXLOC=0 S PXXLOC=$P($$SITE^VASITE,U,1)
S FDAIEN(1)=DA,FDAIEN(2)=PXXLOC
S FDA(9000001,"+1,",.01)=DA
S FDA(9000001.41,"+2,+1,",.01)=PXXLOC
S FDA(9000001.41,"+2,+1,",.02)=PX
D UPDATE^DIE("","FDA","FDAIEN","MSG")
I $D(MSG) D
. D EN^DDIOL("Could not create the PATIENT/IHS entry, due to the following error:")
. D AWRITE^PXUTIL("MSG")
Q
;
KILLSSN ;Entry point from PX09 cross-reference on File 2, field .09 to kill SSN
;information from 9000001.
D CHECK Q:'$T
N DFN S DFN=+DA N DA,X
S X=PX,DA(1)=DFN,DA=$P($G(^PX(815,1,"PXPT")),"^",1) Q:'+DA X ^DD(9000001.41,.02,1,1,2)
Q
;
CHECK ;Check for appropriate variables and globals defined before proceeding
I $D(^AUPNPAT),$G(DA),$D(^DPT(DA))
Q
;
LOAD ;Logic to use during install to initially load ^AUPNPAT(
S PXFG=0
S DA=+$P($G(^PX(815,1,"PXPT")),"^",2)
F S DA=$O(^DPT(DA)) Q:'DA Q:PXFG=1 S PX=$P($G(^DPT(DA,0)),"^",9) D SETSSN D
.S $P(^PX(815,1,"PXPT"),"^",2)=DA
.I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1,PXFG=1
I PXFG'=1 S $P(^PX(815,1,"PXPT"),"^",2)=0
K DR,DIE,DA,PXDA,PXFG
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXXDPT 1603 printed Oct 16, 2024@18:32:59 Page 2
PXXDPT ;ISL/DLT - Synchronize Patient File (2) and IHS Patient File (#9000001) ;05/15/2018
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**1,211**;Aug 12, 1996;Build 454
+2 ;;1.0;PCE Patient/IHS Subset;;Nov 01, 1994
+3 ;
SETSSN ; Entry Point from PX09 cross-reference on File 2, field .09
+1 ;to define patient entry in 9000001.
+2 DO CHECK
if '$TEST
QUIT
EN if PX=""
QUIT
+1 ;DA is the DFN and PX is the SSN.
+2 ;If the patient entry already exists quit.
+3 IF $DATA(^AUPNPAT(DA,0))
QUIT
+4 NEW FDA,FDAIEN,MSG,PXXLOC
+5 SET PXXLOC=+$PIECE($GET(^PX(815,1,"PXPT")),"^",1)
+6 IF PXXLOC=0
SET PXXLOC=$PIECE($$SITE^VASITE,U,1)
+7 SET FDAIEN(1)=DA
SET FDAIEN(2)=PXXLOC
+8 SET FDA(9000001,"+1,",.01)=DA
+9 SET FDA(9000001.41,"+2,+1,",.01)=PXXLOC
+10 SET FDA(9000001.41,"+2,+1,",.02)=PX
+11 DO UPDATE^DIE("","FDA","FDAIEN","MSG")
+12 IF $DATA(MSG)
Begin DoDot:1
+13 DO EN^DDIOL("Could not create the PATIENT/IHS entry, due to the following error:")
+14 DO AWRITE^PXUTIL("MSG")
End DoDot:1
+15 QUIT
+16 ;
KILLSSN ;Entry point from PX09 cross-reference on File 2, field .09 to kill SSN
+1 ;information from 9000001.
+2 DO CHECK
if '$TEST
QUIT
+3 NEW DFN
SET DFN=+DA
NEW DA,X
+4 SET X=PX
SET DA(1)=DFN
SET DA=$PIECE($GET(^PX(815,1,"PXPT")),"^",1)
if '+DA
QUIT
XECUTE ^DD(9000001.41,.02,1,1,2)
+5 QUIT
+6 ;
CHECK ;Check for appropriate variables and globals defined before proceeding
+1 IF $DATA(^AUPNPAT)
IF $GET(DA)
IF $DATA(^DPT(DA))
+2 QUIT
+3 ;
LOAD ;Logic to use during install to initially load ^AUPNPAT(
+1 SET PXFG=0
+2 SET DA=+$PIECE($GET(^PX(815,1,"PXPT")),"^",2)
+3 FOR
SET DA=$ORDER(^DPT(DA))
if 'DA
QUIT
if PXFG=1
QUIT
SET PX=$PIECE($GET(^DPT(DA,0)),"^",9)
DO SETSSN
Begin DoDot:1
+4 SET $PIECE(^PX(815,1,"PXPT"),"^",2)=DA
+5 IF $DATA(ZTQUEUED)
IF $$S^%ZTLOAD
SET ZTSTOP=1
SET PXFG=1
End DoDot:1
+6 IF PXFG'=1
SET $PIECE(^PX(815,1,"PXPT"),"^",2)=0
+7 KILL DR,DIE,DA,PXDA,PXFG
+8 QUIT
