| [613] | 1 | ECXPAI ;ALB/JAP,BIR/DMA,PTD-PAI Extract from File 45.9 ; 10/30/96 14:25
|
|---|
| 2 | ;;3.0;DSS EXTRACTS;**8,20,24,33**;Dec 22, 1997
|
|---|
| 3 | BEG ;entry point from option
|
|---|
| 4 | D SETUP I ECFILE="" Q
|
|---|
| 5 | D ^ECXTRAC,^ECXKILL
|
|---|
| 6 | Q
|
|---|
| 7 | ;
|
|---|
| 8 | START ; start package specific extract
|
|---|
| 9 | N OK
|
|---|
| 10 | S QFLG=0
|
|---|
| 11 | S ECED=ECED+.3,ECD=ECSD1
|
|---|
| 12 | F S ECD=$O(^DG(45.9,"AA",ECD)),ECF=0 Q:'ECD Q:ECD>ECED Q:QFLG F S ECF=$O(^DG(45.9,"AA",ECD,ECF)) Q:'ECF I $D(^DG(45.9,ECF,0)) S EC=^(0),ECXDFN=+EC,ECTD=$P(EC,U,7) D Q:QFLG
|
|---|
| 13 | .K ECXPAT S OK=$$PAT^ECXUTL3(ECXDFN,$P(ECD,"."),"1;",.ECXPAT)
|
|---|
| 14 | .Q:'OK
|
|---|
| 15 | .S X=$$INP^ECXUTL2(ECXDFN,$P(ECD,"."))
|
|---|
| 16 | .S ECXA=$P(X,U),ECXDOM=$P(X,U,10),ECXPNM=ECXPAT("NAME")
|
|---|
| 17 | .S ECXSSN=ECXPAT("SSN"),ECXMPI=ECXPAT("MPI"),ECXRACE=ECXPAT("RACE")
|
|---|
| 18 | .S ECXDSSD="",ECDA=0
|
|---|
| 19 | .F S ECDA=+$O(^DGPM("APCA",ECXDFN,ECDA)),ECTD1=ECTD-.0001 Q:'ECDA I $D(^DGPM(ECDA,0)) F S ECTD1=+$O(^DGPM("APCA",ECXDFN,ECDA,ECTD1)) Q:'ECTD1 Q:ECTD1>(ECTD+.3) D Q:QFLG
|
|---|
| 20 | ..S EC1=0 F S EC1=+$O(^DGPM("APCA",ECXDFN,ECDA,ECTD1,EC1)) Q:'EC1 I $D(^DGPM(EC1,0)),$P(^(0),U,2)'=3 S ECADM=$P(^DGPM(ECDA,0),U) D Q:QFLG
|
|---|
| 21 | ...D FILE
|
|---|
| 22 | Q
|
|---|
| 23 | ;
|
|---|
| 24 | FILE ;file record
|
|---|
| 25 | ;^dfn^ssn^name^i/o (ECXA)^day^admission date^admission time^
|
|---|
| 26 | ;admission/transfer date^admission/transfer time^race
|
|---|
| 27 | ;node1
|
|---|
| 28 | ;mpi^dss dept^dom^extended out patient
|
|---|
| 29 | N DA,DIK
|
|---|
| 30 | S EC7=$O(^ECX(ECFILE,999999999),-1)
|
|---|
| 31 | S ECODEZ="" I EC7>0 S ECODEZ=^ECX(ECFILE,EC7,0)
|
|---|
| 32 | S ECODE=U_U_ECXDFN_U_ECXSSN_U_ECXPNM_U_3_U
|
|---|
| 33 | S ECODE=ECODE_$$ECXDATE^ECXUTL(ECD,ECXYM)_U
|
|---|
| 34 | S ECODE=ECODE_$$ECXDATE^ECXUTL(ECADM,ECXYM)_U
|
|---|
| 35 | S ECODE=ECODE_$$ECXTIME^ECXUTL(ECADM)_U_$$ECXDATE^ECXUTL(ECTD1,ECXYM)_U
|
|---|
| 36 | S ECODE=ECODE_$$ECXTIME^ECXUTL(ECTD1)_U_ECXRACE_U
|
|---|
| 37 | S ECODE1=ECXMPI_U_ECXDSSD_U_ECXDOM_U_$G(ECXEOP)
|
|---|
| 38 | Q:$P(ECODE,U,4,14)=$P(ECODEZ,U,4,14)
|
|---|
| 39 | I $P(ECODE,U,3,7)=$P(ECODEZ,U,5,9),$P(ECODE,U,10)=$P(ECODEZ,U,12),$P(ECODE,U,8,9)'=$P(ECODEZ,10,11) D Q
|
|---|
| 40 | .S $P(^ECX(ECFILE,EC7,0),U,10,11)=$P(ECODE,U,8,9)
|
|---|
| 41 | S EC7=EC7+1
|
|---|
| 42 | S ^ECX(ECFILE,EC7,0)=EC7_U_EC23_ECODE,^ECX(ECFILE,EC7,1)=ECODE1,ECRN=ECRN+1
|
|---|
| 43 | S DA=EC7,DIK="^ECX("_ECFILE_"," D IX1^DIK K DIK,DA
|
|---|
| 44 | I $D(ZTQUEUED),$$S^%ZTLOAD S QFLG=1
|
|---|
| 45 | Q
|
|---|
| 46 | ;
|
|---|
| 47 | SETUP ;Set required input for ECXTRAC
|
|---|
| 48 | S ECHEAD="PAS"
|
|---|
| 49 | D ECXDEF^ECXUTL2(ECHEAD,.ECPACK,.ECGRP,.ECFILE,.ECRTN,.ECPIECE,.ECVER)
|
|---|
| 50 | Q
|
|---|
| 51 | ;
|
|---|
| 52 | QUE ; entry point for the background requeuing handled by ECXTAUTO
|
|---|
| 53 | D SETUP,QUE^ECXTAUTO,^ECXKILL Q
|
|---|
