PXXDPT.m

PXXDPT ;ISL/DLT - Synchronize Patient File (2) and IHS Patient File (#9000001) ;9/3/96

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

 ;;1.0;PCE Patient/IHS Subset;;Nov 01, 1994

 ;IHS/ITSC/LJF 5/28/2003 bypasses VA code - files 2 & 9000001 kept insync by IHS Registration

 ;

SETSSN ; Entry Point from PX09 cross-reference on File 2, field .09

 ;to define patient entry in 9000001.

 ;

 Q   ;IHS/ITSC/LJF 5/28/2003

 ;

 D CHECK Q:'$T

EN Q:PX=""  N DFN,PXXLOC S DFN=+DA N DA,X

 I '$D(^AUPNPAT(DFN,0)) L +^AUPNPAT(0) S $P(^AUPNPAT(0),U,3)=DFN,$P(^AUPNPAT(0),U,4)=$P(^AUPNPAT(0),U,4)+1 L -^AUPNPAT(0)

 S $P(^AUPNPAT(DFN,0),U,1)=DFN

 I '$D(^AUPNPAT(DFN,41,0)) S ^AUPNPAT(DFN,41,0)="^9000001.41P^^"

 S PXXLOC=$P($G(^PX(815,1,"PXPT")),"^",1) Q:'+PXXLOC

 I '$D(^AUPNPAT(DFN,41,PXXLOC,0)) L +^AUPNPAT(DFN,41,0) S $P(^AUPNPAT(DFN,41,0),U,3)=PXXLOC,$P(^AUPNPAT(DFN,41,0),U,4)=$P(^AUPNPAT(DFN,41,0),U,4)+1 L -^AUPNPAT(DFN,41,0)

 S ^AUPNPAT(DFN,41,PXXLOC,0)=PXXLOC_U_PX

 S (DA,X)=DFN X ^DD(9000001,.01,1,1,1) ;code is S ^AUPNPAT("B",$E(X,1,30),DA)=""

 S X=PX,DA(1)=DFN,DA=PXXLOC X ^DD(9000001.41,.02,1,1,1) ;code is S ^AUPNPAT("D",$E(X,1,30),DA(1),DA)=""

 Q

 ;

KILLSSN ;Entry point from PX09 cross-reference on File 2, field .09 to kill SSN

 ;information from 9000001.

 ;

 Q   ;IHS/ITSC/LJF 5/28/2003

 ;

 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(

 ;

 Q   ;IHS/ITSC/LJF 5/28/2003

 ;

 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

PXXDPT    ;ISL/DLT - Synchronize Patient File (2) and IHS Patient File (#9000001) ;9/3/96

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

 +2       ;;1.0;PCE Patient/IHS Subset;;Nov 01, 1994

 +3       ;IHS/ITSC/LJF 5/28/2003 bypasses VA code - files 2 & 9000001 kept insync by IHS Registration

 +4       ;

SETSSN    ; Entry Point from PX09 cross-reference on File 2, field .09

 +1       ;to define patient entry in 9000001.

 +2       ;

 +3       ;IHS/ITSC/LJF 5/28/2003

           QUIT 

 +4       ;

 +5        DO CHECK

           IF '$TEST

               QUIT 

EN         IF PX=""

               QUIT 

           NEW DFN,PXXLOC

           SET DFN=+DA

           NEW DA,X

 +1        IF '$DATA(^AUPNPAT(DFN,0))

               LOCK +^AUPNPAT(0)

               SET $PIECE(^AUPNPAT(0),U,3)=DFN

               SET $PIECE(^AUPNPAT(0),U,4)=$PIECE(^AUPNPAT(0),U,4)+1

               LOCK -^AUPNPAT(0)

 +2        SET $PIECE(^AUPNPAT(DFN,0),U,1)=DFN

 +3        IF '$DATA(^AUPNPAT(DFN,41,0))

               SET ^AUPNPAT(DFN,41,0)="^9000001.41P^^"

 +4        SET PXXLOC=$PIECE($GET(^PX(815,1,"PXPT")),"^",1)

           IF '+PXXLOC

               QUIT 

 +5        IF '$DATA(^AUPNPAT(DFN,41,PXXLOC,0))

               LOCK +^AUPNPAT(DFN,41,0)

               SET $PIECE(^AUPNPAT(DFN,41,0),U,3)=PXXLOC

               SET $PIECE(^AUPNPAT(DFN,41,0),U,4)=$PIECE(^AUPNPAT(DFN,41,0),U,4)+1

               LOCK -^AUPNPAT(DFN,41,0)

 +6        SET ^AUPNPAT(DFN,41,PXXLOC,0)=PXXLOC_U_PX

 +7       ;code is S ^AUPNPAT("B",$E(X,1,30),DA)=""

           SET (DA,X)=DFN

           XECUTE ^DD(9000001,.01,1,1,1)

 +8       ;code is S ^AUPNPAT("D",$E(X,1,30),DA(1),DA)=""

           SET X=PX

           SET DA(1)=DFN

           SET DA=PXXLOC

           XECUTE ^DD(9000001.41,.02,1,1,1)

 +9        QUIT 

 +10      ;

KILLSSN   ;Entry point from PX09 cross-reference on File 2, field .09 to kill SSN

 +1       ;information from 9000001.

 +2       ;

 +3       ;IHS/ITSC/LJF 5/28/2003

           QUIT 

 +4       ;

 +5        DO CHECK

           IF '$TEST

               QUIT 

 +6        NEW DFN

           SET DFN=+DA

           NEW DA,X

 +7        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)

 +8        QUIT 

 +9       ;

CHECK     ;Check for appropriate variables and globals defined before proceeding

 +1        IF $DATA(^AUPNPAT)

               IF $GET(DA)

                   IF $DATA(^DPT(DA))

 +2        QUIT 

LOAD      ;Logic to use during install to initially load ^AUPNPAT(

 +1       ;

 +2       ;IHS/ITSC/LJF 5/28/2003

           QUIT 

 +3       ;

 +4        SET PXFG=0

 +5        SET DA=+$PIECE($GET(^PX(815,1,"PXPT")),"^",2)

 +6        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

 +7                SET $PIECE(^PX(815,1,"PXPT"),"^",2)=DA

 +8                IF $DATA(ZTQUEUED)

                       IF $$S^%ZTLOAD

                           SET ZTSTOP=1

                           SET PXFG=1

               End DoDot:1

 +9        IF PXFG'=1

               SET $PIECE(^PX(815,1,"PXPT"),"^",2)=0

 +10       KILL DR,DIE,DA,PXDA,PXFG

 +11       QUIT