source: FOIAVistA/trunk/r/PCE_PATIENT_CARE_ENCOUNTER-AUTN-EFDP-PX-VSIT--PXRM/PXXDPT.m@ 1783

Last change on this file since 1783 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 1.7 KB
Line 
1PXXDPT ;ISL/DLT - Synchronize Patient File (2) and IHS Patient File (#9000001) ;9/3/96
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**1**;Aug 12, 1996
3 ;;1.0;PCE Patient/IHS Subset;;Nov 01, 1994
4 ;
5SETSSN ; Entry Point from PX09 cross-reference on File 2, field .09
6 ;to define patient entry in 9000001.
7 D CHECK Q:'$T
8EN Q:PX="" N DFN,PXXLOC S DFN=+DA N DA,X
9 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)
10 S $P(^AUPNPAT(DFN,0),U,1)=DFN
11 I '$D(^AUPNPAT(DFN,41,0)) S ^AUPNPAT(DFN,41,0)="^9000001.41P^^"
12 S PXXLOC=$P($G(^PX(815,1,"PXPT")),"^",1) Q:'+PXXLOC
13 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)
14 S ^AUPNPAT(DFN,41,PXXLOC,0)=PXXLOC_U_PX
15 S (DA,X)=DFN X ^DD(9000001,.01,1,1,1) ;code is S ^AUPNPAT("B",$E(X,1,30),DA)=""
16 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)=""
17 Q
18 ;
19KILLSSN ;Entry point from PX09 cross-reference on File 2, field .09 to kill SSN
20 ;information from 9000001.
21 D CHECK Q:'$T
22 N DFN S DFN=+DA N DA,X
23 S X=PX,DA(1)=DFN,DA=$P($G(^PX(815,1,"PXPT")),"^",1) Q:'+DA X ^DD(9000001.41,.02,1,1,2)
24 Q
25 ;
26CHECK ;Check for appropriate variables and globals defined before proceeding
27 I $D(^AUPNPAT),$G(DA),$D(^DPT(DA))
28 Q
29LOAD ;Logic to use during install to initially load ^AUPNPAT(
30 S PXFG=0
31 S DA=+$P($G(^PX(815,1,"PXPT")),"^",2)
32 F S DA=$O(^DPT(DA)) Q:'DA Q:PXFG=1 S PX=$P($G(^DPT(DA,0)),"^",9) D SETSSN D
33 .S $P(^PX(815,1,"PXPT"),"^",2)=DA
34 .I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1,PXFG=1
35 I PXFG'=1 S $P(^PX(815,1,"PXPT"),"^",2)=0
36 K DR,DIE,DA,PXDA,PXFG
37 Q
Note: See TracBrowser for help on using the repository browser.