- 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 Feb 18, 2025@23:58:39 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