Changeset 636 for FOIAVistA/tag/r/DSS_EXTRACTS-ECX
- Timestamp:
- Dec 4, 2009, 8:26:01 PM (15 years ago)
- Location:
- FOIAVistA/tag/r
- Files:
-
- 110 edited
- 1 copied
-
. (copied) (copied from FOIAVistA/trunk/r )
-
DSS_EXTRACTS-ECX/ECX802.m (modified) (1 diff)
-
DSS_EXTRACTS-ECX/ECX8021.m (modified) (1 diff)
-
DSS_EXTRACTS-ECX/ECX8022.m (modified) (1 diff)
-
DSS_EXTRACTS-ECX/ECX804.m (modified) (1 diff)
-
DSS_EXTRACTS-ECX/ECX8041.m (modified) (1 diff)
-
DSS_EXTRACTS-ECX/ECX8042.m (modified) (1 diff)
-
DSS_EXTRACTS-ECX/ECX805.m (modified) (1 diff)
-
DSS_EXTRACTS-ECX/ECX8051.m (modified) (1 diff)
-
DSS_EXTRACTS-ECX/ECX8052.m (modified) (1 diff)
-
DSS_EXTRACTS-ECX/ECX806.m (modified) (1 diff)
-
DSS_EXTRACTS-ECX/ECX8061.m (modified) (1 diff)
-
DSS_EXTRACTS-ECX/ECX8062.m (modified) (1 diff)
-
DSS_EXTRACTS-ECX/ECX808.m (modified) (1 diff)
-
DSS_EXTRACTS-ECX/ECX8081.m (modified) (1 diff)
-
DSS_EXTRACTS-ECX/ECX8082.m (modified) (1 diff)
-
DSS_EXTRACTS-ECX/ECX809.m (modified) (1 diff)
-
DSS_EXTRACTS-ECX/ECX8091.m (modified) (1 diff)
-
DSS_EXTRACTS-ECX/ECX8092.m (modified) (1 diff)
-
DSS_EXTRACTS-ECX/ECX810.m (modified) (1 diff)
-
DSS_EXTRACTS-ECX/ECX8101.m (modified) (1 diff)
-
DSS_EXTRACTS-ECX/ECX8102.m (modified) (1 diff)
-
DSS_EXTRACTS-ECX/ECX811.m (modified) (1 diff)
-
DSS_EXTRACTS-ECX/ECX8111.m (modified) (1 diff)
-
DSS_EXTRACTS-ECX/ECX8112.m (modified) (1 diff)
-
DSS_EXTRACTS-ECX/ECX813.m (modified) (1 diff)
-
DSS_EXTRACTS-ECX/ECX8131.m (modified) (1 diff)
-
DSS_EXTRACTS-ECX/ECX8132.m (modified) (1 diff)
-
DSS_EXTRACTS-ECX/ECX814.m (modified) (1 diff)
-
DSS_EXTRACTS-ECX/ECX8141.m (modified) (1 diff)
-
DSS_EXTRACTS-ECX/ECX8142.m (modified) (1 diff)
-
DSS_EXTRACTS-ECX/ECX815.m (modified) (1 diff)
-
DSS_EXTRACTS-ECX/ECX8151.m (modified) (1 diff)
-
DSS_EXTRACTS-ECX/ECX8152.m (modified) (1 diff)
-
DSS_EXTRACTS-ECX/ECX817.m (modified) (1 diff)
-
DSS_EXTRACTS-ECX/ECX8171.m (modified) (1 diff)
-
DSS_EXTRACTS-ECX/ECX8172.m (modified) (1 diff)
-
DSS_EXTRACTS-ECX/ECX819.m (modified) (1 diff)
-
DSS_EXTRACTS-ECX/ECX8191.m (modified) (1 diff)
-
DSS_EXTRACTS-ECX/ECX8192.m (modified) (1 diff)
-
DSS_EXTRACTS-ECX/ECX820.m (modified) (1 diff)
-
DSS_EXTRACTS-ECX/ECX8201.m (modified) (1 diff)
-
DSS_EXTRACTS-ECX/ECX8202.m (modified) (1 diff)
-
DSS_EXTRACTS-ECX/ECX821.m (modified) (1 diff)
-
DSS_EXTRACTS-ECX/ECX8211.m (modified) (1 diff)
-
DSS_EXTRACTS-ECX/ECX8212.m (modified) (1 diff)
-
DSS_EXTRACTS-ECX/ECX822.m (modified) (1 diff)
-
DSS_EXTRACTS-ECX/ECX8221.m (modified) (1 diff)
-
DSS_EXTRACTS-ECX/ECX8222.m (modified) (1 diff)
-
DSS_EXTRACTS-ECX/ECX823.m (modified) (1 diff)
-
DSS_EXTRACTS-ECX/ECX8231.m (modified) (1 diff)
-
DSS_EXTRACTS-ECX/ECX8232.m (modified) (1 diff)
-
DSS_EXTRACTS-ECX/ECX824.m (modified) (1 diff)
-
DSS_EXTRACTS-ECX/ECX8241.m (modified) (1 diff)
-
DSS_EXTRACTS-ECX/ECX8242.m (modified) (1 diff)
-
DSS_EXTRACTS-ECX/ECX825.m (modified) (1 diff)
-
DSS_EXTRACTS-ECX/ECX8251.m (modified) (1 diff)
-
DSS_EXTRACTS-ECX/ECX8252.m (modified) (1 diff)
-
DSS_EXTRACTS-ECX/ECX826.m (modified) (1 diff)
-
DSS_EXTRACTS-ECX/ECX8261.m (modified) (1 diff)
-
DSS_EXTRACTS-ECX/ECX8262.m (modified) (1 diff)
-
DSS_EXTRACTS-ECX/ECX827.m (modified) (1 diff)
-
DSS_EXTRACTS-ECX/ECX8271.m (modified) (1 diff)
-
DSS_EXTRACTS-ECX/ECX8272.m (modified) (1 diff)
-
DSS_EXTRACTS-ECX/ECX8904.m (modified) (1 diff)
-
DSS_EXTRACTS-ECX/ECX89041.m (modified) (1 diff)
-
DSS_EXTRACTS-ECX/ECX89042.m (modified) (1 diff)
-
DSS_EXTRACTS-ECX/ECXADM.m (modified) (6 diffs)
-
DSS_EXTRACTS-ECX/ECXAPHA2.m (modified) (2 diffs)
-
DSS_EXTRACTS-ECX/ECXATRT.m (modified) (2 diffs)
-
DSS_EXTRACTS-ECX/ECXDIVIV.m (modified) (4 diffs)
-
DSS_EXTRACTS-ECX/ECXDRUG2.m (modified) (2 diffs)
-
DSS_EXTRACTS-ECX/ECXDVSN.m (modified) (11 diffs)
-
DSS_EXTRACTS-ECX/ECXDVSN1.m (modified) (2 diffs)
-
DSS_EXTRACTS-ECX/ECXEC.m (modified) (6 diffs)
-
DSS_EXTRACTS-ECX/ECXFELOC.m (modified) (2 diffs)
-
DSS_EXTRACTS-ECX/ECXKILL.m (modified) (3 diffs)
-
DSS_EXTRACTS-ECX/ECXLABN.m (modified) (7 diffs)
-
DSS_EXTRACTS-ECX/ECXLABR.m (modified) (4 diffs)
-
DSS_EXTRACTS-ECX/ECXLBB.m (modified) (9 diffs)
-
DSS_EXTRACTS-ECX/ECXMOV.m (modified) (4 diffs)
-
DSS_EXTRACTS-ECX/ECXMTL.m (modified) (7 diffs)
-
DSS_EXTRACTS-ECX/ECXNUT.m (modified) (9 diffs)
-
DSS_EXTRACTS-ECX/ECXNUT1.m (modified) (4 diffs)
-
DSS_EXTRACTS-ECX/ECXOPRX.m (modified) (5 diffs)
-
DSS_EXTRACTS-ECX/ECXOPRX1.m (modified) (5 diffs)
-
DSS_EXTRACTS-ECX/ECXPIVDN.m (modified) (6 diffs)
-
DSS_EXTRACTS-ECX/ECXPLBB.m (modified) (4 diffs)
-
DSS_EXTRACTS-ECX/ECXPRO.m (modified) (5 diffs)
-
DSS_EXTRACTS-ECX/ECXPRO1.m (modified) (4 diffs)
-
DSS_EXTRACTS-ECX/ECXQSR.m (modified) (4 diffs)
-
DSS_EXTRACTS-ECX/ECXRAD.m (modified) (5 diffs)
-
DSS_EXTRACTS-ECX/ECXSCLD.m (modified) (2 diffs)
-
DSS_EXTRACTS-ECX/ECXSCX1.m (modified) (2 diffs)
-
DSS_EXTRACTS-ECX/ECXSCX2.m (modified) (2 diffs)
-
DSS_EXTRACTS-ECX/ECXSCXN.m (modified) (4 diffs)
-
DSS_EXTRACTS-ECX/ECXSCXN1.m (modified) (2 diffs)
-
DSS_EXTRACTS-ECX/ECXSURG.m (modified) (8 diffs)
-
DSS_EXTRACTS-ECX/ECXTRAC.m (modified) (2 diffs)
-
DSS_EXTRACTS-ECX/ECXTREX.m (modified) (2 diffs)
-
DSS_EXTRACTS-ECX/ECXTRT.m (modified) (7 diffs)
-
DSS_EXTRACTS-ECX/ECXUD.m (modified) (9 diffs)
-
DSS_EXTRACTS-ECX/ECXUPRO.m (modified) (3 diffs)
-
DSS_EXTRACTS-ECX/ECXUPRO1.m (modified) (2 diffs)
-
DSS_EXTRACTS-ECX/ECXUSUR.m (modified) (3 diffs)
-
DSS_EXTRACTS-ECX/ECXUSUR1.m (modified) (4 diffs)
-
DSS_EXTRACTS-ECX/ECXUTL2.m (modified) (15 diffs)
-
DSS_EXTRACTS-ECX/ECXUTL3.m (modified) (3 diffs)
-
DSS_EXTRACTS-ECX/ECXUTL4.m (modified) (2 diffs)
-
DSS_EXTRACTS-ECX/ECXUTL5.m (modified) (2 diffs)
-
DSS_EXTRACTS-ECX/ECXUTL6.m (modified) (8 diffs)
Legend:
- Unmodified
- Added
- Removed
-
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECX802.m
r628 r636 1 ECX802 ; DRIVER FOR COMPILED XREFS FOR FILE #727.802 ; 02/03/081 ECX802 ; DRIVER FOR COMPILED XREFS FOR FILE #727.802 ; 12/27/07 2 2 ; 3 3 N DH,DU,DIKILL,DISET,DIKJ,DIKZ,DIKYR,DIKZA,DIK0Z,DIKZK,DIKDP,DIKM1,DIKUP,DIKUM,DV,DIIX,DIKF,DIAU,DIKNM,DIKDA,DIKLK,DIKLM,DIKY,DIXR,DIKCOND,DIKSVDA,DIKPUSH,X1,X2 -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECX8021.m
r628 r636 1 ECX8021 ; COMPILED XREF FOR FILE #727.802 ; 02/03/081 ECX8021 ; COMPILED XREF FOR FILE #727.802 ; 12/27/07 2 2 ; 3 3 S DIKZK=2 -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECX8022.m
r628 r636 1 ECX8022 ; COMPILED XREF FOR FILE #727.802 ; 02/03/081 ECX8022 ; COMPILED XREF FOR FILE #727.802 ; 12/27/07 2 2 ; 3 3 S DIKZK=1 -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECX804.m
r628 r636 1 ECX804 ; DRIVER FOR COMPILED XREFS FOR FILE #727.804 ; 10/15/041 ECX804 ; DRIVER FOR COMPILED XREFS FOR FILE #727.804 ; 01/30/05 2 2 ; 3 3 N DH,DU,DIKILL,DISET,DIKJ,DIKZ,DIKYR,DIKZA,DIK0Z,DIKZK,DIKDP,DIKM1,DIKUP,DIKUM,DV,DIIX,DIKF,DIAU,DIKNM,DIKDA,DIKLK,DIKLM,DIKY,DIXR,DIKCOND,DIKSVDA,DIKPUSH,X1,X2 -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECX8041.m
r628 r636 1 ECX8041 ; COMPILED XREF FOR FILE #727.804 ; 10/15/041 ECX8041 ; COMPILED XREF FOR FILE #727.804 ; 01/30/05 2 2 ; 3 3 S DIKZK=2 -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECX8042.m
r628 r636 1 ECX8042 ; COMPILED XREF FOR FILE #727.804 ; 10/15/041 ECX8042 ; COMPILED XREF FOR FILE #727.804 ; 01/30/05 2 2 ; 3 3 S DIKZK=1 -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECX805.m
r628 r636 1 ECX805 ; DRIVER FOR COMPILED XREFS FOR FILE #727.805 ; 12/ 12/071 ECX805 ; DRIVER FOR COMPILED XREFS FOR FILE #727.805 ; 12/27/07 2 2 ; 3 3 N DH,DU,DIKILL,DISET,DIKJ,DIKZ,DIKYR,DIKZA,DIK0Z,DIKZK,DIKDP,DIKM1,DIKUP,DIKUM,DV,DIIX,DIKF,DIAU,DIKNM,DIKDA,DIKLK,DIKLM,DIKY,DIXR,DIKCOND,DIKSVDA,DIKPUSH,X1,X2 -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECX8051.m
r628 r636 1 ECX8051 ; COMPILED XREF FOR FILE #727.805 ; 12/ 12/071 ECX8051 ; COMPILED XREF FOR FILE #727.805 ; 12/27/07 2 2 ; 3 3 S DIKZK=2 -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECX8052.m
r628 r636 1 ECX8052 ; COMPILED XREF FOR FILE #727.805 ; 12/ 12/071 ECX8052 ; COMPILED XREF FOR FILE #727.805 ; 12/27/07 2 2 ; 3 3 S DIKZK=1 -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECX806.m
r628 r636 1 ECX806 ; DRIVER FOR COMPILED XREFS FOR FILE #727.806 ; 10/15/041 ECX806 ; DRIVER FOR COMPILED XREFS FOR FILE #727.806 ; 01/30/05 2 2 ; 3 3 N DH,DU,DIKILL,DISET,DIKJ,DIKZ,DIKYR,DIKZA,DIK0Z,DIKZK,DIKDP,DIKM1,DIKUP,DIKUM,DV,DIIX,DIKF,DIAU,DIKNM,DIKDA,DIKLK,DIKLM,DIKY,DIXR,DIKCOND,DIKSVDA,DIKPUSH,X1,X2 -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECX8061.m
r628 r636 1 ECX8061 ; COMPILED XREF FOR FILE #727.806 ; 10/15/041 ECX8061 ; COMPILED XREF FOR FILE #727.806 ; 01/30/05 2 2 ; 3 3 S DIKZK=2 -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECX8062.m
r628 r636 1 ECX8062 ; COMPILED XREF FOR FILE #727.806 ; 10/15/041 ECX8062 ; COMPILED XREF FOR FILE #727.806 ; 01/30/05 2 2 ; 3 3 S DIKZK=1 -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECX808.m
r628 r636 1 ECX808 ; DRIVER FOR COMPILED XREFS FOR FILE #727.808 ; 02/03/081 ECX808 ; DRIVER FOR COMPILED XREFS FOR FILE #727.808 ; 12/27/07 2 2 ; 3 3 N DH,DU,DIKILL,DISET,DIKJ,DIKZ,DIKYR,DIKZA,DIK0Z,DIKZK,DIKDP,DIKM1,DIKUP,DIKUM,DV,DIIX,DIKF,DIAU,DIKNM,DIKDA,DIKLK,DIKLM,DIKY,DIXR,DIKCOND,DIKSVDA,DIKPUSH,X1,X2 -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECX8081.m
r628 r636 1 ECX8081 ; COMPILED XREF FOR FILE #727.808 ; 02/03/081 ECX8081 ; COMPILED XREF FOR FILE #727.808 ; 12/27/07 2 2 ; 3 3 S DIKZK=2 -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECX8082.m
r628 r636 1 ECX8082 ; COMPILED XREF FOR FILE #727.808 ; 02/03/081 ECX8082 ; COMPILED XREF FOR FILE #727.808 ; 12/27/07 2 2 ; 3 3 S DIKZK=1 -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECX809.m
r628 r636 1 ECX809 ; DRIVER FOR COMPILED XREFS FOR FILE #727.809 ; 02/03/081 ECX809 ; DRIVER FOR COMPILED XREFS FOR FILE #727.809 ; 12/27/07 2 2 ; 3 3 N DH,DU,DIKILL,DISET,DIKJ,DIKZ,DIKYR,DIKZA,DIK0Z,DIKZK,DIKDP,DIKM1,DIKUP,DIKUM,DV,DIIX,DIKF,DIAU,DIKNM,DIKDA,DIKLK,DIKLM,DIKY,DIXR,DIKCOND,DIKSVDA,DIKPUSH,X1,X2 -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECX8091.m
r628 r636 1 ECX8091 ; COMPILED XREF FOR FILE #727.809 ; 02/03/081 ECX8091 ; COMPILED XREF FOR FILE #727.809 ; 12/27/07 2 2 ; 3 3 S DIKZK=2 -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECX8092.m
r628 r636 1 ECX8092 ; COMPILED XREF FOR FILE #727.809 ; 02/03/081 ECX8092 ; COMPILED XREF FOR FILE #727.809 ; 12/27/07 2 2 ; 3 3 S DIKZK=1 -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECX810.m
r628 r636 1 ECX810 ; DRIVER FOR COMPILED XREFS FOR FILE #727.81 ; 02/03/081 ECX810 ; DRIVER FOR COMPILED XREFS FOR FILE #727.81 ; 12/27/07 2 2 ; 3 3 N DH,DU,DIKILL,DISET,DIKJ,DIKZ,DIKYR,DIKZA,DIK0Z,DIKZK,DIKDP,DIKM1,DIKUP,DIKUM,DV,DIIX,DIKF,DIAU,DIKNM,DIKDA,DIKLK,DIKLM,DIKY,DIXR,DIKCOND,DIKSVDA,DIKPUSH,X1,X2 -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECX8101.m
r628 r636 1 ECX8101 ; COMPILED XREF FOR FILE #727.81 ; 02/03/081 ECX8101 ; COMPILED XREF FOR FILE #727.81 ; 12/27/07 2 2 ; 3 3 S DIKZK=2 -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECX8102.m
r628 r636 1 ECX8102 ; COMPILED XREF FOR FILE #727.81 ; 02/03/081 ECX8102 ; COMPILED XREF FOR FILE #727.81 ; 12/27/07 2 2 ; 3 3 S DIKZK=1 -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECX811.m
r628 r636 1 ECX811 ; DRIVER FOR COMPILED XREFS FOR FILE #727.811 ; 02/03/081 ECX811 ; DRIVER FOR COMPILED XREFS FOR FILE #727.811 ; 12/25/06 2 2 ; 3 3 N DH,DU,DIKILL,DISET,DIKJ,DIKZ,DIKYR,DIKZA,DIK0Z,DIKZK,DIKDP,DIKM1,DIKUP,DIKUM,DV,DIIX,DIKF,DIAU,DIKNM,DIKDA,DIKLK,DIKLM,DIKY,DIXR,DIKCOND,DIKSVDA,DIKPUSH,X1,X2 -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECX8111.m
r628 r636 1 ECX8111 ; COMPILED XREF FOR FILE #727.811 ; 02/03/081 ECX8111 ; COMPILED XREF FOR FILE #727.811 ; 12/25/06 2 2 ; 3 3 S DIKZK=2 -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECX8112.m
r628 r636 1 ECX8112 ; COMPILED XREF FOR FILE #727.811 ; 02/03/081 ECX8112 ; COMPILED XREF FOR FILE #727.811 ; 12/25/06 2 2 ; 3 3 S DIKZK=1 -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECX813.m
r628 r636 1 ECX813 ; DRIVER FOR COMPILED XREFS FOR FILE #727.813 ; 02/03/081 ECX813 ; DRIVER FOR COMPILED XREFS FOR FILE #727.813 ; 12/27/07 2 2 ; 3 3 N DH,DU,DIKILL,DISET,DIKJ,DIKZ,DIKYR,DIKZA,DIK0Z,DIKZK,DIKDP,DIKM1,DIKUP,DIKUM,DV,DIIX,DIKF,DIAU,DIKNM,DIKDA,DIKLK,DIKLM,DIKY,DIXR,DIKCOND,DIKSVDA,DIKPUSH,X1,X2 -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECX8131.m
r628 r636 1 ECX8131 ; COMPILED XREF FOR FILE #727.813 ; 02/03/081 ECX8131 ; COMPILED XREF FOR FILE #727.813 ; 12/27/07 2 2 ; 3 3 S DIKZK=2 -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECX8132.m
r628 r636 1 ECX8132 ; COMPILED XREF FOR FILE #727.813 ; 02/03/081 ECX8132 ; COMPILED XREF FOR FILE #727.813 ; 12/27/07 2 2 ; 3 3 S DIKZK=1 -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECX814.m
r628 r636 1 ECX814 ; DRIVER FOR COMPILED XREFS FOR FILE #727.814 ; 02/03/081 ECX814 ; DRIVER FOR COMPILED XREFS FOR FILE #727.814 ; 12/25/06 2 2 ; 3 3 N DH,DU,DIKILL,DISET,DIKJ,DIKZ,DIKYR,DIKZA,DIK0Z,DIKZK,DIKDP,DIKM1,DIKUP,DIKUM,DV,DIIX,DIKF,DIAU,DIKNM,DIKDA,DIKLK,DIKLM,DIKY,DIXR,DIKCOND,DIKSVDA,DIKPUSH,X1,X2 -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECX8141.m
r628 r636 1 ECX8141 ; COMPILED XREF FOR FILE #727.814 ; 02/03/081 ECX8141 ; COMPILED XREF FOR FILE #727.814 ; 12/25/06 2 2 ; 3 3 S DIKZK=2 -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECX8142.m
r628 r636 1 ECX8142 ; COMPILED XREF FOR FILE #727.814 ; 02/03/081 ECX8142 ; COMPILED XREF FOR FILE #727.814 ; 12/25/06 2 2 ; 3 3 S DIKZK=1 -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECX815.m
r628 r636 1 ECX815 ; DRIVER FOR COMPILED XREFS FOR FILE #727.815 ; 02/03/081 ECX815 ; DRIVER FOR COMPILED XREFS FOR FILE #727.815 ; 12/25/06 2 2 ; 3 3 N DH,DU,DIKILL,DISET,DIKJ,DIKZ,DIKYR,DIKZA,DIK0Z,DIKZK,DIKDP,DIKM1,DIKUP,DIKUM,DV,DIIX,DIKF,DIAU,DIKNM,DIKDA,DIKLK,DIKLM,DIKY,DIXR,DIKCOND,DIKSVDA,DIKPUSH,X1,X2 -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECX8151.m
r628 r636 1 ECX8151 ; COMPILED XREF FOR FILE #727.815 ; 02/03/081 ECX8151 ; COMPILED XREF FOR FILE #727.815 ; 12/25/06 2 2 ; 3 3 S DIKZK=2 -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECX8152.m
r628 r636 1 ECX8152 ; COMPILED XREF FOR FILE #727.815 ; 02/03/081 ECX8152 ; COMPILED XREF FOR FILE #727.815 ; 12/25/06 2 2 ; 3 3 S DIKZK=1 -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECX817.m
r628 r636 1 ECX817 ; DRIVER FOR COMPILED XREFS FOR FILE #727.817 ; 02/03/081 ECX817 ; DRIVER FOR COMPILED XREFS FOR FILE #727.817 ; 12/27/07 2 2 ; 3 3 N DH,DU,DIKILL,DISET,DIKJ,DIKZ,DIKYR,DIKZA,DIK0Z,DIKZK,DIKDP,DIKM1,DIKUP,DIKUM,DV,DIIX,DIKF,DIAU,DIKNM,DIKDA,DIKLK,DIKLM,DIKY,DIXR,DIKCOND,DIKSVDA,DIKPUSH,X1,X2 -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECX8171.m
r628 r636 1 ECX8171 ; COMPILED XREF FOR FILE #727.817 ; 02/03/081 ECX8171 ; COMPILED XREF FOR FILE #727.817 ; 12/27/07 2 2 ; 3 3 S DIKZK=2 -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECX8172.m
r628 r636 1 ECX8172 ; COMPILED XREF FOR FILE #727.817 ; 02/03/081 ECX8172 ; COMPILED XREF FOR FILE #727.817 ; 12/27/07 2 2 ; 3 3 S DIKZK=1 -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECX819.m
r628 r636 1 ECX819 ; DRIVER FOR COMPILED XREFS FOR FILE #727.819 ; 02/03/081 ECX819 ; DRIVER FOR COMPILED XREFS FOR FILE #727.819 ; 12/27/07 2 2 ; 3 3 N DH,DU,DIKILL,DISET,DIKJ,DIKZ,DIKYR,DIKZA,DIK0Z,DIKZK,DIKDP,DIKM1,DIKUP,DIKUM,DV,DIIX,DIKF,DIAU,DIKNM,DIKDA,DIKLK,DIKLM,DIKY,DIXR,DIKCOND,DIKSVDA,DIKPUSH,X1,X2 -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECX8191.m
r628 r636 1 ECX8191 ; COMPILED XREF FOR FILE #727.819 ; 02/03/081 ECX8191 ; COMPILED XREF FOR FILE #727.819 ; 12/27/07 2 2 ; 3 3 S DIKZK=2 -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECX8192.m
r628 r636 1 ECX8192 ; COMPILED XREF FOR FILE #727.819 ; 02/03/081 ECX8192 ; COMPILED XREF FOR FILE #727.819 ; 12/27/07 2 2 ; 3 3 S DIKZK=1 -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECX820.m
r628 r636 1 ECX820 ; DRIVER FOR COMPILED XREFS FOR FILE #727.82 ; 10/15/041 ECX820 ; DRIVER FOR COMPILED XREFS FOR FILE #727.82 ; 01/30/05 2 2 ; 3 3 N DH,DU,DIKILL,DISET,DIKJ,DIKZ,DIKYR,DIKZA,DIK0Z,DIKZK,DIKDP,DIKM1,DIKUP,DIKUM,DV,DIIX,DIKF,DIAU,DIKNM,DIKDA,DIKLK,DIKLM,DIKY,DIXR,DIKCOND,DIKSVDA,DIKPUSH,X1,X2 -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECX8201.m
r628 r636 1 ECX8201 ; COMPILED XREF FOR FILE #727.82 ; 10/15/041 ECX8201 ; COMPILED XREF FOR FILE #727.82 ; 01/30/05 2 2 ; 3 3 S DIKZK=2 -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECX8202.m
r628 r636 1 ECX8202 ; COMPILED XREF FOR FILE #727.82 ; 10/15/041 ECX8202 ; COMPILED XREF FOR FILE #727.82 ; 01/30/05 2 2 ; 3 3 S DIKZK=1 -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECX821.m
r628 r636 1 ECX821 ; DRIVER FOR COMPILED XREFS FOR FILE #727.821 ; 10/15/041 ECX821 ; DRIVER FOR COMPILED XREFS FOR FILE #727.821 ; 01/30/05 2 2 ; 3 3 N DH,DU,DIKILL,DISET,DIKJ,DIKZ,DIKYR,DIKZA,DIK0Z,DIKZK,DIKDP,DIKM1,DIKUP,DIKUM,DV,DIIX,DIKF,DIAU,DIKNM,DIKDA,DIKLK,DIKLM,DIKY,DIXR,DIKCOND,DIKSVDA,DIKPUSH,X1,X2 -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECX8211.m
r628 r636 1 ECX8211 ; COMPILED XREF FOR FILE #727.821 ; 10/15/041 ECX8211 ; COMPILED XREF FOR FILE #727.821 ; 01/30/05 2 2 ; 3 3 S DIKZK=2 -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECX8212.m
r628 r636 1 ECX8212 ; COMPILED XREF FOR FILE #727.821 ; 10/15/041 ECX8212 ; COMPILED XREF FOR FILE #727.821 ; 01/30/05 2 2 ; 3 3 S DIKZK=1 -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECX822.m
r628 r636 1 ECX822 ; DRIVER FOR COMPILED XREFS FOR FILE #727.822 ; 10/15/041 ECX822 ; DRIVER FOR COMPILED XREFS FOR FILE #727.822 ; 01/30/05 2 2 ; 3 3 N DH,DU,DIKILL,DISET,DIKJ,DIKZ,DIKYR,DIKZA,DIK0Z,DIKZK,DIKDP,DIKM1,DIKUP,DIKUM,DV,DIIX,DIKF,DIAU,DIKNM,DIKDA,DIKLK,DIKLM,DIKY,DIXR,DIKCOND,DIKSVDA,DIKPUSH,X1,X2 -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECX8221.m
r628 r636 1 ECX8221 ; COMPILED XREF FOR FILE #727.822 ; 10/15/041 ECX8221 ; COMPILED XREF FOR FILE #727.822 ; 01/30/05 2 2 ; 3 3 S DIKZK=2 -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECX8222.m
r628 r636 1 ECX8222 ; COMPILED XREF FOR FILE #727.822 ; 10/15/041 ECX8222 ; COMPILED XREF FOR FILE #727.822 ; 01/30/05 2 2 ; 3 3 S DIKZK=1 -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECX823.m
r628 r636 1 ECX823 ; DRIVER FOR COMPILED XREFS FOR FILE #727.823 ; 10/15/041 ECX823 ; DRIVER FOR COMPILED XREFS FOR FILE #727.823 ; 01/30/05 2 2 ; 3 3 N DH,DU,DIKILL,DISET,DIKJ,DIKZ,DIKYR,DIKZA,DIK0Z,DIKZK,DIKDP,DIKM1,DIKUP,DIKUM,DV,DIIX,DIKF,DIAU,DIKNM,DIKDA,DIKLK,DIKLM,DIKY,DIXR,DIKCOND,DIKSVDA,DIKPUSH,X1,X2 -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECX8231.m
r628 r636 1 ECX8231 ; COMPILED XREF FOR FILE #727.823 ; 10/15/041 ECX8231 ; COMPILED XREF FOR FILE #727.823 ; 01/30/05 2 2 ; 3 3 S DIKZK=2 -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECX8232.m
r628 r636 1 ECX8232 ; COMPILED XREF FOR FILE #727.823 ; 10/15/041 ECX8232 ; COMPILED XREF FOR FILE #727.823 ; 01/30/05 2 2 ; 3 3 S DIKZK=1 -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECX824.m
r628 r636 1 ECX824 ; DRIVER FOR COMPILED XREFS FOR FILE #727.824 ; 02/03/081 ECX824 ; DRIVER FOR COMPILED XREFS FOR FILE #727.824 ; 12/27/07 2 2 ; 3 3 N DH,DU,DIKILL,DISET,DIKJ,DIKZ,DIKYR,DIKZA,DIK0Z,DIKZK,DIKDP,DIKM1,DIKUP,DIKUM,DV,DIIX,DIKF,DIAU,DIKNM,DIKDA,DIKLK,DIKLM,DIKY,DIXR,DIKCOND,DIKSVDA,DIKPUSH,X1,X2 -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECX8241.m
r628 r636 1 ECX8241 ; COMPILED XREF FOR FILE #727.824 ; 02/03/081 ECX8241 ; COMPILED XREF FOR FILE #727.824 ; 12/27/07 2 2 ; 3 3 S DIKZK=2 -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECX8242.m
r628 r636 1 ECX8242 ; COMPILED XREF FOR FILE #727.824 ; 02/03/081 ECX8242 ; COMPILED XREF FOR FILE #727.824 ; 12/27/07 2 2 ; 3 3 S DIKZK=1 -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECX825.m
r628 r636 1 ECX825 ; DRIVER FOR COMPILED XREFS FOR FILE #727.825 ; 02/03/081 ECX825 ; DRIVER FOR COMPILED XREFS FOR FILE #727.825 ; 12/25/06 2 2 ; 3 3 N DH,DU,DIKILL,DISET,DIKJ,DIKZ,DIKYR,DIKZA,DIK0Z,DIKZK,DIKDP,DIKM1,DIKUP,DIKUM,DV,DIIX,DIKF,DIAU,DIKNM,DIKDA,DIKLK,DIKLM,DIKY,DIXR,DIKCOND,DIKSVDA,DIKPUSH,X1,X2 -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECX8251.m
r628 r636 1 ECX8251 ; COMPILED XREF FOR FILE #727.825 ; 02/03/081 ECX8251 ; COMPILED XREF FOR FILE #727.825 ; 12/25/06 2 2 ; 3 3 S DIKZK=2 -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECX8252.m
r628 r636 1 ECX8252 ; COMPILED XREF FOR FILE #727.825 ; 02/03/081 ECX8252 ; COMPILED XREF FOR FILE #727.825 ; 12/25/06 2 2 ; 3 3 S DIKZK=1 -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECX826.m
r628 r636 1 ECX826 ; DRIVER FOR COMPILED XREFS FOR FILE #727.826 ; 02/03/081 ECX826 ; DRIVER FOR COMPILED XREFS FOR FILE #727.826 ; 12/25/06 2 2 ; 3 3 N DH,DU,DIKILL,DISET,DIKJ,DIKZ,DIKYR,DIKZA,DIK0Z,DIKZK,DIKDP,DIKM1,DIKUP,DIKUM,DV,DIIX,DIKF,DIAU,DIKNM,DIKDA,DIKLK,DIKLM,DIKY,DIXR,DIKCOND,DIKSVDA,DIKPUSH,X1,X2 -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECX8261.m
r628 r636 1 ECX8261 ; COMPILED XREF FOR FILE #727.826 ; 02/03/081 ECX8261 ; COMPILED XREF FOR FILE #727.826 ; 12/25/06 2 2 ; 3 3 S DIKZK=2 -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECX8262.m
r628 r636 1 ECX8262 ; COMPILED XREF FOR FILE #727.826 ; 02/03/081 ECX8262 ; COMPILED XREF FOR FILE #727.826 ; 12/25/06 2 2 ; 3 3 S DIKZK=1 -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECX827.m
r628 r636 1 ECX827 ; DRIVER FOR COMPILED XREFS FOR FILE #727.827 ; 02/03/081 ECX827 ; DRIVER FOR COMPILED XREFS FOR FILE #727.827 ; 12/27/07 2 2 ; 3 3 N DH,DU,DIKILL,DISET,DIKJ,DIKZ,DIKYR,DIKZA,DIK0Z,DIKZK,DIKDP,DIKM1,DIKUP,DIKUM,DV,DIIX,DIKF,DIAU,DIKNM,DIKDA,DIKLK,DIKLM,DIKY,DIXR,DIKCOND,DIKSVDA,DIKPUSH,X1,X2 -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECX8271.m
r628 r636 1 ECX8271 ; COMPILED XREF FOR FILE #727.827 ; 02/03/081 ECX8271 ; COMPILED XREF FOR FILE #727.827 ; 12/27/07 2 2 ; 3 3 S DIKZK=2 -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECX8272.m
r628 r636 1 ECX8272 ; COMPILED XREF FOR FILE #727.827 ; 02/03/081 ECX8272 ; COMPILED XREF FOR FILE #727.827 ; 12/27/07 2 2 ; 3 3 S DIKZK=1 -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECX8904.m
r628 r636 1 ECX8904 ; DRIVER FOR COMPILED XREFS FOR FILE #728.904 ; 12/02/051 ECX8904 ; DRIVER FOR COMPILED XREFS FOR FILE #728.904 ; 04/10/06 2 2 ; 3 3 N DH,DU,DIKILL,DISET,DIKJ,DIKZ,DIKYR,DIKZA,DIK0Z,DIKZK,DIKDP,DIKM1,DIKUP,DIKUM,DV,DIIX,DIKF,DIAU,DIKNM,DIKDA,DIKLK,DIKLM,DIKY,DIXR,DIKCOND,DIKSVDA,DIKPUSH,X1,X2 -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECX89041.m
r628 r636 1 ECX89041 ; COMPILED XREF FOR FILE #728.904 ; 12/02/051 ECX89041 ; COMPILED XREF FOR FILE #728.904 ; 04/10/06 2 2 ; 3 3 S DIKZK=2 -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECX89042.m
r628 r636 1 ECX89042 ; COMPILED XREF FOR FILE #728.904 ; 12/02/051 ECX89042 ; COMPILED XREF FOR FILE #728.904 ; 04/10/06 2 2 ; 3 3 S DIKZK=1 -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECXADM.m
r628 r636 1 ECXADM ;ALB/JAP,BIR/DMA,CML,PTD-Admissions Extract ; 10/15/07 12:14pm2 ;;3.0;DSS EXTRACTS;**1,4,11,8,13,24,33,39,46,71,84,92,107 ,105**;Dec 22, 1997;Build 701 ECXADM ;ALB/JAP,BIR/DMA,CML,PTD-Admissions Extract ; 04/12/2007 2 ;;3.0;DSS EXTRACTS;**1,4,11,8,13,24,33,39,46,71,84,92,107**;Dec 22, 1997;Build 9 3 3 BEG ;entry point from option 4 4 D SETUP I ECFILE="" Q … … 46 46 S ECXPRV=$P(ADM,U,7),ECXPRNPI="",ECXATT=$P(ADM,U,8),ECXATNPI="" 47 47 S ECXDOM=$P(ADM,U,10),ECXATTPC=$P(ADM,U,12),ECXPRVPC=$P(ADM,U,11) 48 N ECXUSRTN49 S ECXUSRTN=$$NPI^XUSNPI("Individual_ID",$E(ECXATT,2,$L(ECXATT)),ECD)50 S:+ECXUSRTN'>0 ECXUSRTN=""51 S ECATTNPI=$P(ECXUSRTN,U)52 S ECXUSRTN=$$NPI^XUSNPI("Individual_ID",$E(ECXPRV,2,$L(ECXPRV)),ECD)53 S:+ECXUSRTN'>0 ECXUSRTN=""54 S ECPWNPI=$P(ECXUSRTN,U)55 48 ; 56 49 ;- Observation patient indicator (YES/NO) … … 98 91 S ECXHI=+$$INSUR^IBBAPI(ECXDFN,ECXDATE) 99 92 S ECXEST=ECXPAT("EC STAT") 100 ;101 ;-OEF/OIF Data102 S ECXOEF=ECXPAT("ECXOEF")103 S ECXOEFDT=ECXPAT("ECXOEFDT")104 93 ; 105 94 ;- Agent Orange location … … 156 145 ;^emergency response indicator(FEMA) ECXERI^agent orange indic ECXAO 157 146 ;^environ contam ECXECE^encoun head/neck ECXHNC^encoun MST ECXMIL^rad 158 ;encoun ECXIR^ OEF/OIF ECXOEF^ OEF/OIF return date ECXOEFDT 159 ;^associate pc provider npi ECASNPI^attending physician npi ECATNPI^ 160 ;primary care provider npi ECPTNPI^primary ward provider npi ECPWNPI 147 ;encoun ECXIR 161 148 ; 162 149 ;Convert specialty to PTF Code … … 175 162 S ECODE=ECODE_ECXWRD_U_ECXSPC_U_ECXATT_U_ECDA_U_ECDRG_U_ECDIA_U 176 163 S ECODE=ECODE_ECTM_U_ECPTPR_U_ECXRACE_U_ECXPRV_U 177 S ECODE1=ECXMPI_U_ECXDSSD_U_ ""_U_""_U_""_U_ELGA_U164 S ECODE1=ECXMPI_U_ECXDSSD_U_ECXATNPI_U_ECPTNPI_U_ECXPRNPI_U_ELGA_U 178 165 S ECODE1=ECODE1_ECXMST_U_U_U_U_ECXENRL_U_ECCLAS_U 179 S ECODE1=ECODE1_ECASPR_U_ECCLAS2_U_ U_ECXDOM_U_ECXCAT_U166 S ECODE1=ECODE1_ECASPR_U_ECCLAS2_U_ECASNPI_U_ECXDOM_U_ECXCAT_U 180 167 S ECODE1=ECODE1_ECXSTAT_U_$S(ECXLOGIC<2005:ECXPRIOR,1:"")_U_ECXPHI_U_ECXOBS_U_ECXENC_U_ECXAOL_U 181 168 S ECODE1=ECODE1_ECXPDIV_U_ECXPLOC_U_ECXSADM_U_ECXHNCI_U_ECXETH_U … … 183 170 I ECXLOGIC>2004 S ECODE1=ECODE1_U_ECXPRIOR_ECXSBGRP_U_ECXUESTA_U_ECXPTYPE_U_ECXCVE_U_ECXCVEDT_U_ECXCVENC_U_ECXNPRFI 184 171 I ECXLOGIC>2005 S ECODE1=ECODE1_U_ECXATTPC_U_ECXPRVPC_U_ECXEST 185 I ECXLOGIC>2006 S ECODE1=ECODE1_U_ECXERI_U_ECXAO_U_ECXECE_U_ECXHNC_U_ECXMIL_U_ECXIR_U 186 I ECXLOGIC>2007 S ECODE2=ECXOEF_U_ECXOEFDT_U_ECASNPI_U_ECATTNPI_U_ECPTNPI_U_ECPWNPI 187 S ^ECX(ECFILE,EC7,0)=ECODE,^ECX(ECFILE,EC7,1)=ECODE1,^ECX(ECFILE,EC7,2)=$G(ECODE2) 172 I ECXLOGIC>2006 S ECODE1=ECODE1_U_ECXERI_U_ECXAO_U_ECXECE_U_ECXHNC_U_ECXMIL_U_ECXIR 173 S ^ECX(ECFILE,EC7,0)=ECODE,^ECX(ECFILE,EC7,1)=ECODE1 188 174 S ECRN=ECRN+1 189 175 S DA=EC7,DIK="^ECX("_ECFILE_"," D IX1^DIK K DIK,DA -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECXAPHA2.m
r628 r636 1 ECXAPHA2 ;ALB/TMD-Pharmacy Extracts Unusual Volumes Report ; 10/18/07 2:10pm2 ;;3.0;DSS EXTRACTS;**40,49,84,104 ,105**;Dec 22, 1997;Build 701 ECXAPHA2 ;ALB/TMD-Pharmacy Extracts Unusual Volumes Report ; 2/06/07 10:36am 2 ;;3.0;DSS EXTRACTS;**40,49,84,104**;Dec 22, 1997;Build 8 3 3 ; 4 4 EN ; entry point … … 12 12 ; 13 13 PRE ; entry point for PRE data 14 N ECRFL,ECRX,ECREF,ECDATA,ECDATA1,ECPRC,IEN 15 K ^TMP($J,"ECXDSS") 16 ;call pharmacy api pso52ex 17 D EXTRACT^PSO52EX(ECD,ECED,"ECXDSS") 18 S ECREF="RF" 19 ;order thru fills and refills; refill values 0 thru 11 20 ; Note: refill 0 = original fill 21 F S ECD=$O(^TMP($J,"ECXDSS","AL",ECD)),IEN=0 Q:'ECD Q:ECD>ECED Q:ECXERR F S IEN=$O(^(ECD,IEN)),ECRFL="" Q:'IEN Q:ECXERR F S ECRFL=$O(^(IEN,ECRFL)) Q:'ECRFL Q:ECXERR D PRE2 22 ; 23 ;order thru partial fills 14 ; order through fills, refills and partial refills 15 N ECRFL,ECRX,ECREF,ECDATA,ECDATA1,ECPRC 16 S ECREF=1 17 F S ECD=$O(^PSRX("AL",ECD)),ECRX=0 Q:'ECD Q:ECD>ECED Q:ECXERR F S ECRX=$O(^PSRX("AL",ECD,ECRX)),ECRFL="" Q:'ECRX Q:ECXERR F S ECRFL=$O(^PSRX("AL",ECD,ECRX,ECRFL)) Q:ECRFL="" Q:ECXERR D PRE2 24 18 S ECD=ECSD1,ECREF="P" 25 F S ECD=$O(^TMP($J,"ECXDSS","AM",ECD)),IEN=0 Q:'ECD Q:ECD>ECED Q:ECXERR F S IEN=$O(^(ECD,IEN)),ECRFL="" Q:'IEN Q:ECXERR F S ECRFL=$O(^(IEN,ECRFL)) Q:'ECRFL Q:ECXERR D PRE2 26 K ^TMP($J,"ECXDSS") 19 F S ECD=$O(^PSRX("AM",ECD)),ECRX=0 Q:'ECD Q:ECD>ECED Q:ECXERR F S ECRX=$O(^PSRX("AM",ECD,ECRX)),ECRFL="" Q:'ECRX F S ECRFL=$O(^PSRX("AM",ECD,ECRX,ECRFL)) Q:ECRFL="" Q:ECXERR D PRE2 27 20 Q 28 21 ; 29 22 PRE2 ; get Prescription data 30 I (ECREF="RF")&(ECRFL) D 31 .S ECQTY=+^TMP($J,"ECXDSS",IEN,ECREF,ECRFL,1) 32 .S ECDS=+^TMP($J,"ECXDSS",IEN,ECREF,ECRFL,1.1) 33 .S ECPRC=^TMP($J,"ECXDSS",IEN,ECREF,ECRFL,1.2) 34 I (ECREF="RF")&('ECRFL) D 35 .S ECQTY=+^TMP($J,"ECXDSS",IEN,7) 36 .S ECDS=+^TMP($J,"ECXDSS",IEN,8) 37 .S ECPRC=+^TMP($J,"ECXDSS",IEN,17) 38 I ECREF="P" D 39 .S ECQTY=+^TMP($J,"ECXDSS",IEN,ECREF,ECRFL,.04) 40 .S ECDS=+^TMP($J,"ECXDSS",IEN,ECREF,ECRFL,.041) 41 .S ECPRC=+^TMP($J,"ECXDSS",IEN,ECREF,ECRFL,.042) 23 S ECDATA=$G(^PSRX(ECRX,0)) 24 I ECRFL D 25 .S ECDATA1=$G(^PSRX(ECRX,ECREF,ECRFL,0)) 26 .S ECQTY=+$P(ECDATA1,U,4) 27 .S ECDS=+$P(ECDATA1,U,10) 28 .S ECPRC=+$P(ECDATA1,U,11) 29 I 'ECRFL D 30 .S ECQTY=+$P(ECDATA,U,7) 31 .S ECDS=+$P(ECDATA,U,8) 32 .S ECPRC=+$P(ECDATA,U,17) 42 33 ;check to see if quantity>threshold 43 34 I ECQTY>ECTHLD D 44 35 .S ECDAY=ECD 45 .S ECDFN=$P( ^TMP($J,"ECXDSS",IEN,2),U)46 .S ECDRG=+$P( ^TMP($J,"ECXDSS",IEN,6),U)36 .S ECDFN=$P(ECDATA,U,2) 37 .S ECDRG=+$P(ECDATA,U,6) 47 38 .S ECCOST=ECQTY*ECPRC 48 39 .D FILE Q:ECXERR -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECXATRT.m
r628 r636 1 1 ECXATRT ;ALB/JAP - TRT Extract Audit Report ;O4/12/2007 2 ;;3.0;DSS EXTRACTS;**1,6,8,107 ,105**;Dec 22, 1997;Build 702 ;;3.0;DSS EXTRACTS;**1,6,8,107**;Dec 22, 1997;Build 9 3 3 ; 4 4 EN ;entry point for TRT extract audit report … … 87 87 ..; 88 88 ..N ECXTS 89 ..S ECXTS=$P(DATA,U,15) I ECXTS'="" S ECXTS=$O(^DIC(42.4,"C",$G(ECXTS),0)),$P(DATA,U,15)=ECXTS90 ..S ECXTS=$P(DATA,U,16) I ECXTS'="" S ECXTS=$O(^DIC(42.4,"C",$G(ECXTS),0)),$P(DATA,U,16)=ECXTS89 ..S ECXTS=$P(DATA,U,15),ECXTS=$O(^DIC(42.4,$G(ECXTS),"C",$P(DATA,U,15),0)),$P(DATA,U,15)=ECXTS 90 ..S ECXTS=$P(DATA,U,16),ECXTS=$O(^DIC(42.4,$G(ECXTS),"C",$P(DATA,U,16),0)),$P(DATA,U,16)=ECXTS 91 91 ..S NEWTS=$P(DATA,U,15),TS=$P(DATA,U,16),LOS=$P(DATA,U,17) 92 92 ..;leaving this next line in here for v3.0 extracts done prior to patch #1 93 ..Q:(NUM( +TS)=1)&(NEWTS=TS)93 ..Q:(NUM(TS)=1)&(NEWTS=TS) 94 94 ..Q:LOS="" 95 95 ..S $P(^(TS),U,1)=$P(^TMP($J,"ECXSPEC",DIV,TS),U,1)+1,CNT=CNT+1 -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECXDIVIV.m
r628 r636 1 ECXDIVIV ;BIR/CML-Enter/Edit and Print IV Room Division ; 3/13/07 10:48am2 ;;3.0;DSS EXTRACTS;**8 ,105**;Dec 22, 1997;Build 701 ECXDIVIV ;BIR/CML-Enter/Edit and Print IV Room Division ; [ 11/15/96 11:12 AM ] 2 ;;3.0;DSS EXTRACTS;**8**;Dec 22, 1997 3 3 ; 4 4 ED ;enter/edit division field for iv rooms … … 25 25 .W !,"NO DEVICE SELECTED OR REPORT PRINTED!!" 26 26 .D PAUSE 27 K ^TMP($J,"ECXDSS")28 27 Q 29 28 ; … … 31 30 N CHKFLG,DIV,DIVNM,INACT,IV,IVRM,JJ,LN1,LN2,PDT,PG,QFLG,SS,X,Y 32 31 I '$D(DT) S DT=$$HTFM^XLFDT(+$H) 33 K ^TMP("ECXDIVIV",$J),^TMP($J,"ECXDSS") S QFLG=0,IV=0 34 ;call pharmacy encapsulation api and return all iv rooms information 35 D ALL^PSJ59P5(,"??","ECXDSS") 36 F S IV=$O(^TMP($J,"ECXDSS",IV)) Q:'IV D 37 .S IVRM=$G(^TMP($J,"ECXDSS",IV,.01)),DIV=$P($G(^(.02)),U) 32 K ^TMP("ECXDIVIV",$J) S QFLG=0,IV=0 33 F S IV=$O(^PS(59.5,IV)) Q:'IV I $D(^PS(59.5,IV,0)) D 34 .S IVRM=$E($P(^PS(59.5,IV,0),U),1,30),DIV=$P(^(0),U,4) 38 35 .S DIVNM=$S(DIV="":"ZZZ",1:$E($P(^DG(40.8,DIV,0),U),1,30)) 39 .K INACT I $P($G(^ TMP($J,"ECXDSS",IV,19)),U)]"" S INACT=$P(^(19),U,2)36 .K INACT I $P($G(^PS(59.5,IV,"I")),U)]"" S INACT=$$FMTE^XLFDT($P(^PS(59.5,IV,"I"),U),1) 40 37 .S ^TMP("ECXDIVIV",$J,DIVNM,IVRM)=$S($D(INACT):INACT,1:"") 41 38 ;print report … … 67 64 CHK ;check for existence of necessary files for division functionality 68 65 S CHKFLG=0 69 D ALL^PSJ59P5(,"??","ECXIV") 70 I '$O(^TMP($J,"ECXIV",0)) D I CHKFLG D EXIT Q 66 I '$O(^PS(59.5,0)) D Q:CHKFLG 71 67 .W !,"The IV Room file (#59.5) does not exist!" 72 68 .S CHKFLG=1 D PAUSE 73 I '$D(^ECX(728.113,0)) D I CHKFLG D EXIT Q69 I '$D(^ECX(728.113,0)) D Q:CHKFLG 74 70 .W $C(7),!!,"Your facility appears to be running a version of Inpatient Medications prior to" 75 71 .W !,"version 4.5 which is necessary to use this option." 76 72 .S CHKFLG=1 D PAUSE 77 I '$D(^TMP($J,"ECXIV",$O(^TMP($J,"ECXIV",0)),.02)) D 73 K TEST1 D FIELD^DID(59.5,.02,"","TYPE","TEST1") 74 I '$D(TEST1) D 78 75 .W $C(7),!!,"The Inpatient Medications Patch PSJ*4.5*27 has not yet been installed!" 79 76 .W !,"It must be loaded before you can proceed with this option." 80 77 .S CHKFLG=1 D PAUSE 81 EXIT K ^TMP($J,"ECXIV")82 78 Q 83 79 ; -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECXDRUG2.m
r628 r636 1 ECXDRUG2 ;ALB/TMD-Pharmacy Extracts Incomplete Feeder Key Report ; 2/19/08 3:44pm2 ;;3.0;DSS EXTRACTS;**40,68,84 ,105,111**;Dec 22, 1997;Build 41 ECXDRUG2 ;ALB/TMD-Pharmacy Extracts Incomplete Feeder Key Report ; 6/13/05 3:31pm 2 ;;3.0;DSS EXTRACTS;**40,68,84**;Dec 22, 1997 3 3 ; 4 4 EN ; entry point … … 13 13 ; order through fills, refills and partial refills 14 14 N ECRFL,ECRX,ECREF,ECDATA,ECDATA1 15 K ^TMP($J,"ECXDSS") 16 ;call pharmacy api pso52ex 17 D EXTRACT^PSO52EX(ECD,ECED,"ECXDSS") 18 S ECREF="RF" 19 ;order thru fills and refills; refill values 0 thru 11 20 ; Note: refill 0 = original fill 21 F S ECD=$O(^TMP($J,"ECXDSS","AL",ECD)),IEN=0 Q:'ECD Q:ECD>ECED Q:ECXERR F S IEN=$O(^(ECD,IEN)),ECRFL="" Q:'IEN Q:ECXERR F S ECRFL=$O(^(IEN,ECRFL)) Q:ECRFL']"" Q:ECXERR D PRE2 22 ; 23 ;order thru partial fills 15 S ECREF=1 16 F S ECD=$O(^PSRX("AL",ECD)),ECRX=0 Q:'ECD Q:ECD>ECED Q:ECXERR F S ECRX=$O(^PSRX("AL",ECD,ECRX)),ECRFL="" Q:'ECRX F S ECRFL=$O(^PSRX("AL",ECD,ECRX,ECRFL)) Q:ECRFL="" Q:ECXERR D PRE2 24 17 S ECD=ECSD1,ECREF="P" 25 F S ECD=$O(^TMP($J,"ECXDSS","AM",ECD)),IEN=0 Q:'ECD Q:ECD>ECED Q:ECXERR F S IEN=$O(^(ECD,IEN)),ECRFL="" Q:'IEN Q:ECXERR F S ECRFL=$O(^(IEN,ECRFL)) Q:'ECRFL Q:ECXERR D PRE2 26 K ^TMP($J,"ECXDSS") 18 F S ECD=$O(^PSRX("AM",ECD)),ECRX=0 Q:'ECD Q:ECD>ECED Q:ECXERR F S ECRX=$O(^PSRX("AM",ECD,ECRX)),ECRFL="" Q:'ECRX F S ECRFL=$O(^PSRX("AM",ECD,ECRX,ECRFL)) Q:ECRFL="" D PRE2 27 19 Q 28 20 ; 29 21 PRE2 ; get Prescription data 30 S ECD RG=+$P(^TMP($J,"ECXDSS",IEN,6),U)31 I ECRFL>0&(ECREF="RF") D32 .S ECQTY=^TMP($J,"ECXDSS",IEN,ECREF,ECRFL,1),ECPRC=^(1.2)33 I ECRFL>0&(ECREF="P") D34 .S ECQTY= ^TMP($J,"ECXDSS",IEN,ECREF,ECRFL,.04),ECPRC=^(.042)35 I 'ECRFL S ECQTY= ^TMP($J,"ECXDSS",IEN,7),ECPRC=^(17)22 S ECDATA=$G(^PSRX(ECRX,0)) 23 S ECDRG=+$P(ECDATA,U,6) 24 I ECRFL D 25 .S ECDATA1=$G(^PSRX(ECRX,ECREF,ECRFL,0)) 26 .S ECQTY=+$P(ECDATA1,U,4),ECPRC=+$P(ECDATA1,U,11) 27 I 'ECRFL S ECQTY=+$P(ECDATA,U,7),ECPRC=+$P(ECDATA,U,17) 36 28 D TEST 37 29 Q -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECXDVSN.m
r628 r636 1 ECXDVSN ;ALB/JAP - Division selection utility ; 8/13/07 1:11pm 2 ;;3.0;DSS EXTRACTS;**8,105**;Dec 22, 1997;Build 70 1 ECXDVSN ;ALB/JAP - Division selection utility ;Sep 29, 1997 2 ;;3.0;DSS EXTRACTS;**8**;Dec 22, 1997 3 ; 3 4 ADM(ECXDIV,ECXALL,ECXSTART,ECXEND,ECXERR) ;division information for ADM extract audit report 4 5 ;selected inpatient divisions from medical center division file (#40.8) … … 23 24 ; ECXERR = 1, if input problem occurs 24 25 ; 0, otherwise 26 ; 25 27 N OUT,DIC,X,Y,NM,ECXD,ECXIEN,ECXDIEN,ECXACT,ECXNAME,ECXNUM 26 28 S (OUT,ECXERR)=0 … … 53 55 I '$D(ECXDIV) S ECXERR=1 54 56 Q 57 ; 55 58 ACTDIV(ECXIEN,ECXSTART,ECXEND,ECXD,ECXACT) ;determine if division active at anytime during date range 56 59 ;to be called by ADM^ECXDVSN … … 78 81 I DATE(ECXSTART)=-1,DATE(ECXEND)=-1 S ECXACT=0 79 82 Q 83 ; 80 84 MOV(ECXDIV,ECXALL,ECXSTART,ECXEND,ECXERR) ;division information for MOV extract audit report 81 85 ;selected divisions from medical center division file (#40.8) … … 84 88 ; output 85 89 ; (see ADM) 90 ; 86 91 D ADM^ECXDVSN(.ECXDIV,ECXALL,ECXSTART,ECXEND,.ECXERR) 87 92 Q 93 ; 88 94 PAS(ECXDIV,ECXALL,ECXERR) ;setup division/site information for PAS extract audit report 89 95 ; input … … 94 100 ; ECXDIV(1)=ien in file #4^name^station number 95 101 ; where the INSTITUTION file pointer is obtained from file #728 102 ; 96 103 S ECXALL=1 D DEFAULT^ECXDVSN(.ECXDIV,ECXALL,.ECXERR) 97 104 Q 105 ; 98 106 TRT(ECXDIV,ECXALL,ECXERR) ;setup division/site information for TRT extract audit report 99 107 ; input … … 104 112 ; ECXDIV(1)=ien in file #4^name^station number 105 113 ; where the INSTITUTION file pointer is obtained from file #728 114 ; 106 115 S ECXALL=1 D DEFAULT^ECXDVSN(.ECXDIV,ECXALL,.ECXERR) 107 116 Q 117 ; 108 118 DEFAULT(ECXDIV,ECXALL,ECXERR) ;default division/site information for audit report 109 119 ; input … … 114 124 ; ECXDIV(1)=ien in file #4^name^station number 115 125 ; where the INSTITUTION file pointer is obtained from file #728 126 ; 116 127 N DIV,ECX 117 128 S ECXERR=0 … … 123 134 I '$D(ECXDIV) S ECXERR=1 124 135 Q 136 ; 125 137 DEN(ECXDIV,ECXALL,ECXERR) ;setup division/site information for DEN extract audit report 126 138 ; input … … 157 169 I '$D(ECXDIV) S ECXERR=1 158 170 Q 171 ; 159 172 ECS(ECXDIV,ECXALL,ECXERR) ;setup division/location information for ECS extract audit report 160 173 ; input … … 206 219 I '$D(ECXDIV) S ECXERR=1 207 220 Q 208 NUT() ; Set Divisions into screen array (prompt is one/many/all)209 ;Input : SCRNARR - Screen array full global reference210 ;Output : 1 = OK 0 = User abort/timeout211 ; @SCRNARR@("DIVISION") = User pick all divisions ?212 ; 1 = Yes (all) 0 = No213 ; @SCRNARR@("DIVISION",PtrDiv) = Division name214 ;Note : @SCRNARR@("DIVISION") is initialized (KILLed) on input215 ; : @SCRNARR@("DIVISION",PtrDiv) is only set when the user216 ; picked individual divisions (i.e. didn't pick all)217 ;218 ;Declare variables219 N VAUTD,Y,SCANARR220 ;Get division selection221 S DIC="^DIC(4,"222 S VAUTSTR="PATIENT DIVISION"223 S VAUTVB="SCANARR"224 S VAUTNI=2225 D FIRST^VAUTOMA226 I Y<0 Q 1227 M @SCRNARR@("DIVISION")=SCANARR228 Q 0 -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECXDVSN1.m
r628 r636 1 ECXDVSN1 ;ALB/JAP - Division selection utility (cont.) ; 3/30/07 7:56am2 ;;3.0;DSS EXTRACTS;**8 ,105**;Dec 22, 1997;Build 701 ECXDVSN1 ;ALB/JAP - Division selection utility (cont.) ;Sep 30, 1997 2 ;;3.0;DSS EXTRACTS;**8**;Dec 22, 1997 3 3 ; 4 4 ECQ(ECXDIV,ECXALL,ECXERR) ;setup division/site information for QSR extract audit report … … 134 134 ; if input problem, then '1' returned 135 135 ; 136 N X,Y,DIC,DIQ,DA,OUT,ECXARR,ECXP,ECXIEN ,ARRAY136 N X,Y,DIC,DIQ,DA,OUT,ECXARR,ECXP,ECXIEN 137 137 S:'$D(ECXALL) ECXALL=1 S:ECXALL="" ECXALL=1 138 S ECXERR=0,ECXP="",ARRAY="^TMP($J,""ECXDSS"")" 139 K @ARRAY 138 S ECXERR=0,ECXP="" 140 139 ;if ecxall=1, then all pharmacy sites are selected or there's only one 141 140 I ECXALL=1 S ECXP="" D 142 .D PSS^PSO59(,"??","ECXDSS") 143 .F S ECXP=$O(@ARRAY@("B",ECXP)) Q:ECXP="" S ECXIEN=$O(^(ECXP,0)) Q:'ECXIEN Q:'$D(^(ECXIEN)) D 144 ..S ECXDIV(ECXIEN)=ECXIEN_U_@ARRAY@(ECXIEN,.01)_U_^(.06)_U_^(100) 141 .F S ECXP=$O(^PS(59,"B",ECXP)) Q:ECXP="" S ECXIEN=$O(^(ECXP,"")) D 142 ..K ECXARR S DIC="^PS(59,",DR=".01;.06;100",DIQ="ECXARR",DA=ECXIEN D EN^DIQ1 143 ..Q:'$D(ECXARR) 144 ..S ECXDIV(ECXIEN)=ECXIEN_U_ECXARR(59,ECXIEN,.01)_U_ECXARR(59,ECXIEN,.06)_U_ECXARR(59,ECXIEN,100) 145 145 ;if ecxall=0, then user selects pharmacy site(s) 146 146 I ECXALL=0 S OUT=0 D 147 147 .F Q:OUT!ECXERR D 148 ..N DIC,X,Y,DUOUT,DTOUT 149 ..S DIC="^PS(59,",DIC(0)="AEMQZ" 150 ..D DIC^PSODI(59,.DIC,.X) 148 ..S DIC="^PS(59,",DIC(0)="AEMQZ" K X,Y D ^DIC 151 149 ..I $G(DUOUT)!($G(DTOUT)) S OUT=1,ECXERR=1 Q 152 150 ..I Y=-1,X="" S OUT=1 Q 153 .. D PSS^PSO59(+Y,,"ECXDSS")154 ..Q:'$D( @ARRAY)155 ..S ECXDIV(ECXIEN)=ECXIEN_U_ @ARRAY@(ECXIEN,.01)_U_^(.06)_U_^(100)151 ..K ECXARR S (ECXIEN,DA)=+Y,DIC="^PS(59,",DR=".01;.06;100",DIQ="ECXARR" D EN^DIQ1 152 ..Q:'$D(ECXARR) 153 ..S ECXDIV(ECXIEN)=ECXIEN_U_ECXARR(59,ECXIEN,.01)_U_ECXARR(59,ECXIEN,.06)_U_ECXARR(59,ECXIEN,100) 156 154 ; 157 155 I ECXERR=1 K ECXDIV -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECXEC.m
r628 r636 1 ECXEC ;ALB/JAP,BIR/JLP,PTD-DSS Event Capture Extract ; 10/2/07 2:33pm2 ;;3.0;DSS EXTRACTS;**11,8,13,24,27,33,39,46,49,71,89,92 ,105**;Dec 22, 1997;Build 701 ECXEC ;ALB/JAP,BIR/JLP,PTD-DSS Event Capture Extract [ 02/14/97 2:26 PM ] ; 12/2/04 12:35pm 2 ;;3.0;DSS EXTRACTS;**11,8,13,24,27,33,39,46,49,71,89,92**;Dec 22, 1997;Build 30 3 3 BEG ;entry point from option 4 4 I '$D(^ECH) W !,"Event Capture is not initialized",!! Q … … 67 67 F I=1:1:3 S Y=$O(ECXPRV("")) I Y'="" S @("ECU"_I)=+ECXPRV(Y) K ECXPRV(Y) 68 68 S:$L(ECU1) ECXPPC1=$$PRVCLASS^ECXUTL(ECU1,ECDT),ECU1A="2"_$P(ECU1,";") 69 S ECXUSRTN=$$NPI^XUSNPI("Individual_ID",ECU1,ECDT)70 S:+ECXUSRTN'>0 ECXUSRTN="" S ECU1NPI=$P(ECXUSRTN,U)71 69 S:$L(ECU2) ECXPPC2=$$PRVCLASS^ECXUTL(ECU2,ECDT),ECU2A="2"_$P(ECU2,";") 72 S ECXUSRTN=$$NPI^XUSNPI("Individual_ID",ECU2,ECDT)73 S:+ECXUSRTN'>0 ECXUSRTN="" S ECU2NPI=$P(ECXUSRTN,U)74 70 S:$L(ECU3) ECXPPC3=$$PRVCLASS^ECXUTL(ECU3,ECDT),ECU3A="2"_$P(ECU3,";") 75 S ECXUSRTN=$$NPI^XUSNPI("Individual_ID",ECU3,ECDT)76 S:+ECXUSRTN'>0 ECXUSRTN="" S ECU3NPI=$P(ECXUSRTN,U)77 71 ;change for version 2 where ECP is a variable pointer and we want to 78 72 ;expand it category = category or null if stored as 0 … … 128 122 ;ECPCE7^^dss identifier ECDSS^dss dept 129 123 ;node1 130 ;mpi ECXMPI^dss dept ECXDSSD^ PLACEHOLDER131 ;p laceholder^placeholder^placeholder^132 ;p laceholder^pc prov person class ECCLAS^124 ;mpi ECXMPI^dss dept ECXDSSD^provider npi ECXPRV2^ 125 ;provider #2 npi ECU2NPI^provider #3 npi ECU3NPI^^ 126 ;pc provider npi ECPTNPI^pc prov person class ECCLAS^ 133 127 ;assoc pc prov ECASPR^assoc pc prov person class ECCLAS2^ 134 ; placeholder^128 ;assoc pc prov npi ECASNPI^ 135 129 ;divison ECXDIV^mst status ECXMST^dom ECXDOM^date of birth ECXDOB^ 136 130 ;enrollment category ECXCAT^ enrollment status ECXSTAT^enrollment … … 147 141 ;ECXNPRFI^emerg response indic(FEMA) ECXERI^agent orange indic ECXAO^ 148 142 ;environ contam ECXECE^head/neck cancer ECXHNC^encntr mst ECXMIL 149 ;^radiation ECXIR^OEF/OIF ECXOEF^OEF/OIF return date ECXOEFDT 150 ;^associate pc provider npi ECASNPI^primary care provider npi ECPTNPI^ 151 ;provider npi ECU1NPI^provider #2 ECU2NPI^provider #3 ECU3NPI 143 ;^radiation ECXIR 152 144 N DA,DIK 153 145 S EC7=$O(^ECX(ECFILE,999999999),-1),EC7=EC7+1 … … 161 153 S ECODE=ECODE_ECXICD94_U_ECXAST_U_ECXRST_U_ECXEST_U 162 154 S ECODE=ECODE_ECSC_U_ECPCE7_U_U_ECDSS_U_U 163 S ECODE1=ECXMPI_U_ECXDSSD_U_ U_U_U_ECCLAS_U164 S ECODE1=ECODE1_ U_ECASPR_U_ECCLAS2_U_U_ECXDIV_U155 S ECODE1=ECXMPI_U_ECXDSSD_U_ECU1NPI_U_ECU2NPI_U_ECU3NPI_U_ECCLAS_U 156 S ECODE1=ECODE1_ECPTNPI_U_ECASPR_U_ECCLAS2_U_ECASNPI_U_ECXDIV_U 165 157 S ECODE1=ECODE1_ECXMST_U_ECXDOM_U_ECXDOB_U_ECXCAT_U_ECXSTAT_U 166 158 S ECODE1=ECODE1_$S(ECXLOGIC<2005:ECXPRIOR,1:"")_U_ECXPOS_U_ECXPHI_U_ECXOBS_U_ECXENC_U_ECXAOL_U … … 171 163 I ECXLOGIC>2004 S ECODE2=ECXCVEDT_U_ECXCVENC_U_ECXNPRFI 172 164 I ECXLOGIC>2006 S ECODE2=ECODE2_U_ECXERI_U_ECXAO_U_ECXECE_U_ECXHNC_U_ECXMIL_U_ECXIR_U 173 I ECXLOGIC>2007 S ECODE2=ECODE2_U_ECXOEF_U_ECXOEFDT_U_ECASNPI_U_ECPTNPI_U_ECU1NPI_U_ECU2NPI_U_ECU3NPI174 165 S ^ECX(ECFILE,EC7,0)=ECODE,^ECX(ECFILE,EC7,1)=ECODE1,^ECX(ECFILE,EC7,2)=$G(ECODE2),ECRN=ECRN+1 175 166 S DA=EC7,DIK="^ECX("_ECFILE_"," D IX1^DIK K DIK,DA -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECXFELOC.m
r628 r636 1 ECXFELOC ;BIR/DMA,CML-Print Feeder Locations; [ 05/07/96 8:41 AM ] ; 6/12/07 6:29am2 ;;3.0;DSS EXTRACTS;**1,8 ,105**;Dec 22, 1997;Build 701 ECXFELOC ;BIR/DMA,CML-Print Feeder Locations; [ 05/07/96 8:41 AM ] 2 ;;3.0;DSS EXTRACTS;**1,8**;Dec 22, 1997 3 3 EN ;entry point from option 4 4 W !!,"Print list of feeder locations.",! S QFLG=1 … … 16 16 CLI S EC=0 F S EC=$O(^SC(EC)) Q:'EC I $D(^(EC,0)) S EC1=^(0),ECS=$P(EC1,U,15),ECSC=$P($G(^DIC(40.7,+$P(EC1,U,7),0)),U,2),ECD=$P(EC1,U) S:'ECS ECS=1 D 17 17 .I $P(EC1,U,17)'="Y",$P(EC1,U,3)="C" S DAT=$G(^SC(EC,"I")),ID=+DAT,RD=$P(DAT,U,2) I 'ID!(ID>DT)!(RD&(RD<DT)) S ^TMP($J,"CLI",ECS_ECSC,EC)=ECD 18 PRE N ARRAY S ARRAY="^TMP($J,""ECXDSS"")" K @ARRAY D PSS^PSO59(,"??","ECXDSS") I @ARRAY@(0)>0 G V6 19 ;dbia (#4689) 18 PRE I $O(^PS(59,0)) G V6 20 19 S EC=0 F S EC=$O(^DIC(59,EC)) Q:'EC I $D(^(EC,0)) S EC1=$E($P(^(0),U),1,30),^TMP($J,"PRE","PRE"_EC,EC)="Prescriptions-"_EC1 21 20 G RAD 22 V6 S EC=0 F S EC=$O(@ARRAY@(EC)) Q:'EC I $D(^(EC)) S EC1=$E(@ARRAY@(EC,.01),1,30),^TMP($J,"PRE","PRE"_EC,EC)="Prescriptions-"_EC1 23 K @ARRAY 21 V6 S EC=0 F S EC=$O(^PS(59,EC)) Q:'EC I $D(^(EC,0)) S EC1=$E($P(^(0),U),1,30),^TMP($J,"PRE","PRE"_EC,EC)="Prescriptions-"_EC1 24 22 RAD S EC=0 F S EC=$O(^RA(79,EC)),EC1=0 Q:'EC I $D(^(EC,0)) S ECD=$P(^(0),U) F S EC1=$O(^RA(79.2,EC1)) Q:'EC1 I $D(^(EC1,0)) S ECD1=$P(^(0),U),^TMP($J,"RAD",EC_"-"_EC1,EC_"-"_EC1)=ECD_"-"_ECD1 25 23 NUR S EC=0 F S EC=$O(^NURSF(211.4,EC)) Q:'EC I $D(^(EC,0)) S EC1=$P(^(0),U),EC1=$P($G(^SC(+EC1,0)),U),^TMP($J,"NUR",EC,EC)=EC1 -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECXKILL.m
r628 r636 1 ECXKILL ;BIR/DMA,PTD-Kill Local Variables ; 5/30/20072 ;;3.0;DSS EXTRACTS;**9,8,21,24,31,39,49,84,89 ,92,105**;Dec 22, 1997;Build 701 ECXKILL ;BIR/DMA,PTD-Kill Local Variables ; 9/13/05 10:24am 2 ;;3.0;DSS EXTRACTS;**9,8,21,24,31,39,49,84,89**;Dec 22, 1997 3 3 ; 4 4 K %,%DT,%Y,%ZIS,A,A1,A2,ABR,B,BY,D,D0,D1,DA,DAT,DATA,DATA1,DATA2,DATA6 5 5 K DATAOP,DD,DFN,DHDH,DIC,DIE,DIK,DINUM,DIQ 6 K ECDAPRNP,ECDPRNPI,ECISNPI,ECDOCNPI7 K ECU1NPI,ECU2NPI,ECU3NPI8 6 K DIR,DIRUT,DO,DR,DTOUT,DUOUT,EC,EC0,EC1,EC10,EC11,EC16,EC2,EC23,EC2NODE 9 7 K EC3,EC42,EC50,EC6,EC7,ECA,ECAC,ECACA,ECAD,ECADM,ECALL … … 18 16 K ECXMISS,ECMN,ECMOD,ECMODS,ECMORE,ECMS,ECMSG,ECMSN,ECMT,ECMW,ECMY,ECN 19 17 K ECNA,ECNDC,ECNDF,ECNFC,ECNL,ECNO,ECNODE,ECNOGO 20 K ECNT,ECO,ECO0,ECO1,ECO2,ECOB,ECODE,ECODE0,ECODE1,ECODE2,ECOLD,ECONE,ECOPAY 21 K ECATTNPI,ECPWNPI,ECXUSNPI,ECPWNPI,ECXOEF,ECXOEFDT,ECPLACE 18 K ECNT,ECO,ECO0,ECO1,ECO2,ECOB,ECODE,ECODE0,ECODE1,ECOLD,ECONE,ECOPAY 22 19 K ECOPAYT,ECORTY,ECOS,ECP,ECPACK,ECPCE,ECPCE1,ECPCE2,ECPCE3,ECPCE4 23 20 K ECPCE5,ECPCE6,ECPCE7,ECPIECE,ECPN,ECPRC,ECPRO,ECODE2 … … 29 26 ; 30 27 AUDIT ;kill audit report variables, close slave printer 31 K %DT,ECX,ECXARRAY,ECXACC,ECXALL,ECXAUD,ECXCODE,ECXD,ECXDEF,ECXDESC,ECXDIV28 K ECX,ECXARRAY,ECXACC,ECXALL,ECXAUD,ECXCODE,ECXD,ECXDEF,ECXDESC,ECXDIV 32 29 K ECXRCST,ECXRQST,ECXEND,ECXERR,ECXEXT,ECXHEAD,ECXLOC,ECXPGM,ECXPHCPC 33 30 K ECXPRIME,ECXPRO,ECXREPT,ECXRUN,ECXSAVE,ECXSTART,ECXSRCE -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECXLABN.m
r628 r636 1 ECXLABN ;ALB/JAP,BIR/CML-Lab Extract for DSS (New Format - With LMIP Codes) ; 10/23/07 3:01pm2 ;;3.0;DSS EXTRACTS;**1,11,8,13,28,24,30,31,32,33,39,42,46,70,71,80,92,107 ,105**;Dec 22, 1997;Build 701 ECXLABN ;ALB/JAP,BIR/CML-Lab Extract for DSS (New Format - With LMIP Codes) ; 4/25/07 8:52am 2 ;;3.0;DSS EXTRACTS;**1,11,8,13,28,24,30,31,32,33,39,42,46,70,71,80,92,107**;Dec 22, 1997;Build 9 3 3 BEG ;entry point 4 4 D SETUP I ECFILE="" Q … … 22 22 F S ECLRN=$O(^LRO(64.03,ECLRN)) Q:'ECLRN D Q:QFLG 23 23 .Q:'$D(^LRO(64.03,ECLRN,0)) 24 .S EC1=^LRO(64.03,ECLRN,0),ECDOC=ECPROF_$P(EC1,U,2) 25 .S ECDOCNPI=$$NPI^XUSNPI("Individual_ID",$P(EC1,U,2),$P(EC1,U,4)) 26 .S:+ECDOCNPI'>0 ECDOCNPI="" S ECDOCNPI=$P(ECDOCNPI,U) 24 .S EC1=^LRO(64.03,ECLRN,0),ECDOC=ECPROF_$P(EC1,U,2),ECDOCNPI="" 27 25 .S ECLOC=$P(EC1,U,15),EC=$P(EC1,U,3),ECDOCPC=$$PRVCLASS^ECXUTL($P(EC1,U,2),$P(EC1,U,4)) 28 26 .I EC]"" D GET … … 32 30 ; 33 31 GET ;get data 34 N X,ECXSTN ,QFLAG32 N X,ECXSTN 35 33 S ECF=$S($P(EC,";",2)="DPT(":2,$P(EC,";",2)="LRT(67,":67,1:0) Q:'ECF 36 S ECIFN=$P(EC,";") ,QFLAG=034 S ECIFN=$P(EC,";") 37 35 ;resolve ecloc 38 36 S ECXL1=+$P(ECLOC,";",1),ECXL2=$P(ECLOC,";",2) … … 51 49 Q:ECXERR 52 50 ;get patient data if record is in file #67 53 I ECF=67 S ECSN="000123456",ECNA="RFRL" I $D(^LRT(67,ECIFN,0)) D Q:QFLAG51 I ECF=67 S ECSN="000123456",ECNA="RFRL" I $D(^LRT(67,ECIFN,0)) D 54 52 .S ECXMPI="",EC0=^LRT(67,ECIFN,0),ECNA=$E($P($P(EC0,U),",")_" ",1,4) 55 53 .S ECSN=$P(EC0,U,9),ECXERI="" D … … 60 58 ..I $L(ECSN)=9,ECSN'?9N S ECSN="000123456" Q 61 59 ..I $L(ECSN)=10,ECSN'?9N1"P" S ECSN="000123456" 62 ..I '$$SSN^ECXUTL5(ECSN,ECF) S QFLAG=163 60 ; 64 61 ;- Only set treating spec (TS) to TS in file #64.03 if it does not exist … … 120 117 ;ord stop code ECXORDST^ord date ECXORDDT^production division 121 118 ;ECXPDIV^^ordering provider person class^emergency response indicator 122 ;(FEMA) ECXERI^associate pc provider npi ECASNPI^primary care provider 123 ;npi ECPTNPI^provider npi ECDOCNPI 119 ;(FEMA) ECXERI 124 120 ;ECDOCPC 125 121 N DA,DIK … … 135 131 S ECODE=ECODE_ECPTTM_U_ECPTPR_U 136 132 ;(ECACA=acc area^abbreviation) 137 S ECODE1=ECXMPI_U_ECXDSSD_U_ U_U_ECCLAS_U_ECASPR_U138 S ECODE1=ECODE1_ECCLAS2_U_ U_ECXDOM_U_ECXOBS_U_ECXENC_U133 S ECODE1=ECXMPI_U_ECXDSSD_U_ECDOCNPI_U_ECPTNPI_U_ECCLAS_U_ECASPR_U 134 S ECODE1=ECODE1_ECCLAS2_U_ECASNPI_U_ECXDOM_U_ECXOBS_U_ECXENC_U 139 135 S ECODE1=ECODE1_ECXORDST_U_ECXORDDT_U_ECXPDIV_U 140 136 I ECXLOGIC>2004 S ECODE1=ECODE1_U_ECDOCPC 141 137 I ECXLOGIC>2006 S ECODE1=ECODE1_U_ECXERI 142 I ECXLOGIC>2007 S ECODE1=ECODE1_U_ECASNPI_U_ECPTNPI_U_ECDOCNPI143 138 S ^ECX(ECFILE,EC7,0)=ECODE,^ECX(ECFILE,EC7,1)=ECODE1,ECRN=ECRN+1 144 139 S DA=EC7,DIK="^ECX("_ECFILE_"," D IX1^DIK K DIK,DA -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECXLABR.m
r628 r636 1 ECXLABR ;ALB/JAP,BIR/CML-LAR Extract for DSS (New Format - With LMIP Codes) ; 6/5/07 2:33pm2 ;;3.0;DSS EXTRACTS;**8,24,33,37,39,46,71,80,107 ,105**;Dec 22, 1997;Build 701 ECXLABR ;ALB/JAP,BIR/CML-LAR Extract for DSS (New Format - With LMIP Codes) ; 4/12/07 8:43am 2 ;;3.0;DSS EXTRACTS;**8,24,33,37,39,46,71,80,107**;Dec 22, 1997;Build 9 3 3 BEG ;entry point from option 4 4 D SETUP I ECFILE="" Q … … 31 31 ..S ECXDATE=$P(EC1,U,9)_"."_$P(EC1,U,10) 32 32 ..I ECPTPR S ECCLASS=$$PRVCLASS^ECXUTL(ECPTPR,ECXDATE) 33 ..I ECPTPR S ECPTNPI=$$NPI^XUSNPI("Individual_ID",ECPTPR,+ECXDATE) D34 ...S:+ECPTNPI'>0 ECPTNPI="" S ECPTNPI=$P(ECPTNPI,U)35 33 ..S ECORDT=$$ECXDATE^ECXUTL($P(EC1,U,4),ECXYM) 36 34 ..S ECORTM=$$ECXTIME^ECXUTL($P(EC1,U,4)_"."_$P(EC1,U,5)) … … 93 91 ;observ pat ind (ECXOBS)^encounter num (ECXENC)^prod div ECXPDIV^ 94 92 ;lab results translation ECXTRANS^ordering provider (ECPTPR)^ 95 ;ordering provider person class (ECCLASS) ^ordering provider npi ECPTNPI93 ;ordering provider person class (ECCLASS) 96 94 N DA,DIK 97 95 S EC7=$O(^ECX(ECFILE,999999999),-1),EC7=EC7+1 … … 107 105 S ECODE1=ECXMPI_U_ECXDSSD_U_ECXDOM_U_ECSCTM_U_ECXOBS_U_ECXENC_U_ECXPDIV_U_ECTRANS 108 106 I ECXLOGIC>2004 S ECODE1=ECODE1_U_2_ECPTPR_U_ECCLASS 109 I ECXLOGIC>2007 S ECODE1=ECODE1_U_ECPTNPI110 107 S ^ECX(ECFILE,EC7,0)=ECODE,^ECX(ECFILE,EC7,1)=ECODE1,ECRN=ECRN+1 111 108 S DA=EC7,DIK="^ECX("_ECFILE_"," D IX1^DIK K DIK,DA -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECXLBB.m
r628 r636 1 ECXLBB ;DALOI/KML - DSS BLOOD BANK EXTRACT ; 10/17/07 10:33am2 ;;3.0;DSS EXTRACTS;**78,84,90,92,104 ,105**;Dec 22, 1997;Build 701 ECXLBB ;DALOI/KML - DSS BLOOD BANK EXTRACT ; 2/22/07 11:42am 2 ;;3.0;DSS EXTRACTS;**78,84,90,92,104**;Dec 22, 1997;Build 8 3 3 ;Per VHA Directive 97-033 this routine should not be modified. Medical Device # BK970021 4 4 ; access to the LAB DATA file (#63) is supported by … … 12 12 START ; Entry point from tasked job 13 13 ; begin package specific extract 14 N ECTRSP,ECADMT,ECTODT,ECENCTR,ECPAT,ECLRDFN,ECXPHY,ECXPHYPC ,ECPHYNPI14 N ECTRSP,ECADMT,ECTODT,ECENCTR,ECPAT,ECLRDFN,ECXPHY,ECXPHYPC 15 15 N ECD,ECXDFN,ECARRY,EC66,ECERR,ECTRFDT,ECTRFTM,ECX,ECINOUT,ECXINST 16 16 ;variables ECFILE,EC23,ECXYM,ECINST,ECSD,ECSD1,ECED passed in … … 37 37 .; ECARRY(7)=VOLUME TRANSFUSED, ECARRY(8)=TRANSFUSION REACTION TYPE 38 38 .; ECARRY(9)=REQUESTING PROVIDER, ECARRY(10)=REQUEST. PROV. PERSON CLASS 39 .; ECARRY(11)=UNIT MODIFIED, ECARRY(12)=UNIT MODIFICATION39 .; ECARRY(11)=UNIT MODIFIED, ECARRY(12)=UNIT MODIFICATION 40 40 .; ECARRY(13)=PRODUCTION DIVISION CODE 41 41 . S ECARRY(1)=$P(EC0,"^"),EC66=$G(^LAB(66,$P(EC0,"^",2),0)) … … 45 45 . S ECARRY(8)=$E($P($G(^LAB(65.4,+$P(EC0,"^",11),0)),"^"),1,10) 46 46 . S (ECARRY(9),ECARRY(10),ECARRY(13))="" D GETRPRV 47 . S ECARRY(1 1)=$$MODIFIED(),(ECXPHY,ECXPHYPC,ECPHYNPI)=""48 . S ECARRY(12)=$S(ECARRY(11)="Y":$$UNITMODS(),1:"")47 . S ECARRY(12)=$$UNITMOD(),ECARRY(11)=$S(ECARRY(12)'="":"Y",1:"N") 48 . S (ECXPHY,ECXPHYPC)="" 49 49 . D GETDATA 50 50 . K ECARRY 51 51 Q 52 52 ; 53 UNITMOD S() ; Get modification criteria from fields #.06 and #3 from file #6653 UNITMOD() ; Get modification criteria from fields #.06 and #3 from file #66 54 54 N MODARY,MO,EC66A,MODSTR,STR3 55 55 S MODARY("DIVIDED")="D",MODARY("POOLED")="P",MODARY("WASHED")="W" … … 58 58 S MODARY("IRRADIATED")="I",MODARY("SEPARATED")="S" 59 59 ;if modification criteria is null determine value from description 60 S MODSTR=$S($P(EC66,U,6)'="":$P(EC66,U,6),1:$$CHKMOD ^ECXLBB1($P(EC66,"^")))60 S MODSTR=$S($P(EC66,U,6)'="":$P(EC66,U,6),1:$$CHKMOD($P(EC66,"^"))) 61 61 ;get modification criteria for entries at field #3 in file #66 62 62 S MOD=0 F S MOD=$O(^LAB(66,$P(EC0,"^",2),3,MOD)) Q:'MOD D 63 63 .S EC66A=$G(^LAB(66,MOD,0)) I EC66A="" Q 64 .S STR3=$S($P(EC66A,U,6)'="":$P(EC66A,U,6),1:$$CHKMOD ^ECXLBB1($P(EC66A,"^")))64 .S STR3=$S($P(EC66A,U,6)'="":$P(EC66A,U,6),1:$$CHKMOD($P(EC66A,"^"))) 65 65 .I STR3'="",MODSTR'[STR3 S MODSTR=MODSTR_STR3 66 66 Q MODSTR 67 67 ; 68 MODIFIED() ; Was unit modified 69 ; Init variables 70 N XMATCH,UNIT,MOD,COMPID,MODNODE,MODTO 71 S (XMATCH,UNIT)=0,MOD="" 72 ; Check input 73 Q:'$G(ECLRDFN)!'$P(EC0,U,2) "N" 74 ;Find xmatch for blood component request 75 S XMATCH=$O(^LR(ECLRDFN,1.8,$P(EC0,U,2),1,XMATCH)) Q:'XMATCH "N" 76 ;Get blood inventory file (#65) pointer 77 S UNIT=$P($G(^LR(ECLRDFN,1.8,$P(EC0,"^",2),1,XMATCH,0)),U) 78 ;Look at disposition field (#4.1) in blood inventory file (#65) 79 S MOD=$P($G(^LRD(65,+XMATCH,4)),U),COMPID=$P(EC66,U,3) 80 ; Get 'the modified to' entry pointer to blood inventory file (#66) 81 I MOD="MO" S MODTO=0 F S MODTO=$O(^LRD(65,+XMATCH,9,MODTO)) Q:'MODTO D 82 .S MODNODE=$G(^LRD(65,+XMATCH,9,MODTO,0)) Q:$P(^(0),U,3)'>1 83 .Q:$P(MODNODE,U,2)'=COMPID 84 .; Set the modify to unit ien for file (#66) 85 Q $S(MOD="MO":"Y",1:"N") 86 ; 68 CHKMOD(MD) ;check if modifier is contained in string 69 N RES,MODX 70 I MD="" Q "" 71 S (RES,MODX)="" F S MODX=$O(MODARY(MODX)) Q:MODX="" D I RES'="" Q 72 .I MD[MODX S RES=MODARY(MODX) 73 Q RES 87 74 GETRPRV ; get requesting provider, requesting provider person class and 88 75 ; production division code … … 110 97 . S PERCLS=$$GET^XUA4A72(ECARRY(9),ACCDT) 111 98 . I +PERCLS>0 S ECARRY(10)=$P(PERCLS,U,7) 112 . S ECREQNPI=$$NPI^XUSNPI("Individual_ID",ECARRY(9),ACCDT)113 . S:+ECREQNPI'>0 ECREQNPI="" S ECREQNPI=$P(ECREQNPI,U)114 99 . S ECARRY(9)=2_ECARRY(9) 115 100 S DIV=$P($G(^LRO(68,+AREA,1,ACCDT,1,NUM,.4)),U) … … 155 140 I $G(ECXLOGIC)>2005 S ECXSTR=ECXSTR_U_ECXPHY_U_ECXPHYPC 156 141 I $G(ECXLOGIC)>2006 D 157 .S ECXSTR=ECXSTR_U_ECXERI_U_ECARRY(11)_U_ECARRY(12)_U_ECARRY(9)_U_ECARRY(10)_U_ECARRY(13) _U142 .S ECXSTR=ECXSTR_U_ECXERI_U_ECARRY(11)_U_ECARRY(12)_U_ECARRY(9)_U_ECARRY(10)_U_ECARRY(13) 158 143 I '$D(ECXRPT) D FILE(ECXSTR) Q 159 144 S ^TMP("ECXLBB",$J,ECXDFN,ECD)=ECXSTR ;temporary global array … … 194 179 ; ordering physician^ordering physician pc^emergency response indicator 195 180 ; (FEMA)^unit modified^unit modification^requesting provider^request. 196 ; provider person class^ordering provider npi ECPHYNPI 197 ;ECODE1- requesting provider npi ECREQNPI 181 ; provider person class 198 182 ;note: DSS product dept and DSS IP # are dependent on the release of 199 183 ; ECX*3*61 … … 201 185 S EC7=$O(^ECX(ECFILE,999999999),-1),EC7=EC7+1 202 186 S ECODE=EC7_"^"_ECODE 203 I ECXLOGIC>2007 D 204 .S ECODE=ECODE_ECPHYNPI_U 205 .S ECODE1=$G(ECREQNPI) 206 S ^ECX(ECFILE,EC7,0)=ECODE,^ECX(ECFILE,EC7,1)=$G(ECODE1),ECRN=ECRN+1 187 S ^ECX(ECFILE,EC7,0)=ECODE,ECRN=ECRN+1 207 188 S DA=EC7,DIK="^ECX("_ECFILE_"," D IX1^DIK K DIK,DA 208 189 Q -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECXMOV.m
r628 r636 1 ECXMOV ;ALB/JAP,BIR/DMA,PTD-Transfer and Discharge Extract ; 6/6/07 6:46am2 ;;3.0;DSS EXTRACTS;**8,24,33,39,41,42,46,65,84 ,107,105**;Dec 22, 1997;Build 701 ECXMOV ;ALB/JAP,BIR/DMA,PTD-Transfer and Discharge Extract ; 8/19/05 9:13am 2 ;;3.0;DSS EXTRACTS;**8,24,33,39,41,42,46,65,84**;Dec 22, 1997 3 3 BEG ;entry point from option 4 4 D SETUP I ECFILE="" Q … … 60 60 ....S ECXDSC=$$PRIMARY^ECXUTL2(ECXDFN,ECD) 61 61 ....S ECXDPCT=$P(ECXDSC,U),ECXDPR=$P(ECXDSC,U,2),ECXDAPR=$P(ECXDSC,U,5),ECXDPRPC=$P(ECXDSC,U,3),ECXDAPPC=$P(ECXDSC,U,6) 62 ....S ECDAPRNP=$P(ECXDSC,U,7),ECDPRNPI=$P(ECXDSC,U,4)63 62 ...; 64 63 ...;Get production division ;p-46 … … 84 83 ;disch assoc prim prov ECXDAPR^production division ECXPDIV 85 84 ;^disch prov person class ECXDPRPC^disch assoc prov pe- 86 ;rson person class ^disch assoc pc prov npi ECDAPRNP^discharge pc provider npi ECDPRNPI85 ;rson person class 87 86 N DA,DIK 88 87 S EC7=$O(^ECX(ECFILE,999999999),-1),EC7=EC7+1 … … 95 94 S ECODE1=ECODE1_ECXDPCT_U_ECXDAPR_U_ECXPDIV ;p-46 added ECXPDIV 96 95 I ECXLOGIC>2005 S ECODE1=ECODE1_U_ECXDPRPC_U_ECXDAPPC 97 I ECXLOGIC>2007 S ECODE1=ECODE1_U_$G(ECDAPRNP)_U_$G(ECDPRNPI)98 96 S ^ECX(ECFILE,EC7,0)=ECODE,^ECX(ECFILE,EC7,1)=ECODE1,ECRN=ECRN+1 99 97 S DA=EC7,DIK="^ECX("_ECFILE_"," D IX1^DIK K DIK,DA -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECXMTL.m
r628 r636 1 ECXMTL ;ALB/JAP - DSS Mental Health Extract ; 8/17/07 9:52am2 ;;3.0;DSS EXTRACTS;**24,30,33,39,46,49,71,82,84,92 ,105**;Dec 22, 1997;Build 701 ECXMTL ;ALB/JAP - DSS Mental Health Extract ; 9/11/06 11:07am 2 ;;3.0;DSS EXTRACTS;**24,30,33,39,46,49,71,82,84,92**;Dec 22, 1997;Build 30 3 3 ; 4 4 BEG ;entry point from option … … 31 31 .S ECXSCNUM=$P(^ECX(ECFILE,JJ,0),U,23),ECXSCNAM=$P(^ECX(ECFILE,JJ,0),U,24) 32 32 .D PAT(ECXDFN,ECXDATE) 33 .S (ECXPRCLS,EC PRNPI,ECXDIV,ECXPDIV)="" I ECXPRV D PROV(.ECXPRV,ECXDATE)33 .S (ECXPRCLS,ECXPRNPI,ECXDIV,ECXPDIV)="" I ECXPRV D PROV(.ECXPRV,ECXDATE) 34 34 .S ECXDSSI="" 35 35 .I ECXLOGIC>2003 D … … 79 79 S ECXA=$P(X,U),(ECXADT,ECXADMDT)=$P($P(X,U,4),"."),ECXDCDT=$P($P(X,U,6),".") 80 80 S ECXWPRV=$P(X,U,7),ECXATT=$P(X,U,8) 81 S ECWPRNPI=$$NPI^XUSNPI("Individual_ID",ECXWPRV,ECXDATE)82 S:+ECWPRNPI'>0 ECWPRNPI="" S ECWPRNPI=$P(ECWPRNPI,U)83 S ECATTNPI=$$NPI^XUSNPI("Individual_ID",ECXATT,ECXDATE)84 S:+ECATTNPI'>0 ECATTNPI="" S ECATTNPI=$P(ECATTNPI,U)85 81 ;Get ward provider and attending phy person classes 86 82 S ECXWPRPC=$P(X,U,11),ECXATTPC=$P(X,U,12) … … 92 88 N INST,DGIEN,ARR,DIC,DR,DA,DIQ 93 89 S ECXPRCLS=$$PRVCLASS^ECXUTL(ECXPRV,ECXDATE) 94 S ECPRNPI=$$NPI^XUSNPI("Individual_ID",ECXPRV,ECXDATE) 95 S:+ECPRNPI'>0 ECPRNPI="" S ECPRNPI=$P(ECPRNPI,U) 90 S ECXPRNPI="" 96 91 ;get division identifier using provider 97 92 S (ECXDIV,ECXPDIV)="" … … 119 114 ;day ECXDATE^division ECXDIV^admit date ECXADMDT^ 120 115 ;d/c date ECXDCDT^dss id ECXDSSI^pc team ECPTTM^pc provider ECPTPR^ 121 ;p laceholder^pc prov person class ECCLAS^122 ;provider ECXPRV^p laceholder^prov person class ECXPRCLS^116 ;pc provider npi ECPTNPI^pc prov person class ECCLAS^ 117 ;provider ECXPRV^provider npi ECXPRNPI^prov person class ECXPRCLS^ 123 118 ;test name ECXSCNAM(?)^test ien ECXSCNUM(?)^scale number^scale name^ 124 119 ;test score^scale score^attend phys^ward provider 125 120 ;node1 126 ;mpi^assoc pc provider^ placeholder^121 ;mpi^assoc pc provider^assoc pc provider npi^ 127 122 ;assoc pc prov person class^asi class^asi special^asi encounter date^ 128 123 ;purple heart ind.^dom prrtp & saartp ind.^enrollment cat^ … … 135 130 ;enc cv eligible ECXCVENC^national patient record flag ECXNPRFI 136 131 ;attending phy person class ECXATTPC^ward provider person class 137 ;ECXWPRPC^^agent orange status ECXAST^asso prov npi ECASNPI^att phy 138 ;npi ECATTNPI^primary care prov npi ECPTNPI^provider npi ECPRNPI^ward 139 ;provider npi ECWPRNPI 132 ;ECXWPRPC^^agent orange status ECXAST 140 133 N DA,DIK,STR 141 134 I $P(^ECX(ECFILE,JJ,0),U,21)="ASI" S $P(^ECX(ECFILE,JJ,1),U,7)=ECXDATE 142 135 S $P(^ECX(ECFILE,JJ,0),U,6,9)=ECXSSN_U_ECXPNM_U_ECXA_U_ECXDATE 143 136 S STR=$S(ECXLOGIC<2005:ECXDIV,1:"")_U_ECXADMDT_U_ECXDCDT_U_ECXDSSI_U_ECPTTM_U_ECPTPR_U 144 S STR=STR_ U_ECCLAS,$P(^ECX(ECFILE,JJ,0),U,10,17)=STR,STR=""145 S $P(^ECX(ECFILE,JJ,0),U,18,20)=ECXPRV_U_ U_ECXPRCLS137 S STR=STR_ECPTNPI_U_ECCLAS,$P(^ECX(ECFILE,JJ,0),U,10,17)=STR,STR="" 138 S $P(^ECX(ECFILE,JJ,0),U,18,20)=ECXPRV_U_ECXPRNPI_U_ECXPRCLS 146 139 S $P(^ECX(ECFILE,JJ,0),U,23,24)=ECXSCNUM_U_ECXSCNAM 147 140 S $P(^ECX(ECFILE,JJ,0),U,27,29)=ECXATT_U_ECXWPRV_U 148 141 I '$D(^ECX(ECFILE,JJ,1)) S ^ECX(727.812,JJ,1)="^^^^^" 149 S $P(^ECX(ECFILE,JJ,1),U,1,4)=ECXMPI_U_ECASPR_U_ U_ECCLAS2142 S $P(^ECX(ECFILE,JJ,1),U,1,4)=ECXMPI_U_ECASPR_U_ECASNPI_U_ECCLAS2 150 143 S STR=ECXPHI_U_ECXDOM_U_ECXCAT_U_ECXSTAT_U_$S(ECXLOGIC<2005:ECXPRIOR,1:"")_U_ECXPOS_U 151 144 S STR=STR_ECXOBS_U_ECXENC_U_ECXAOL_U_ECXDOB_U_ECXPDIV_U_ECXDEPT_U … … 154 147 I ECXLOGIC>2005 S STR=STR_U_ECXATTPC_U_ECXWPRPC 155 148 S $P(^ECX(ECFILE,JJ,1),U,8,22)=STR 156 I ECXLOGIC>2006 S $P(^ECX(ECFILE,JJ,1),U,34)=ECXAST_U 157 I ECXLOGIC>2007 S $P(^ECX(ECFILE,JJ,1),U,35)=ECASNPI_U_ECATTNPI_U_ECPTNPI_U D 158 . S ^ECX(ECFILE,JJ,2)=ECPRNPI_U_ECWPRNPI 149 I ECXLOGIC>2006 S $P(^ECX(ECFILE,JJ,1),U,34)=ECXAST 159 150 S DA=JJ,DIK="^ECX("_ECFILE_"," D IX1^DIK K DIK,DA 160 151 S ECRN=ECRN+1 -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECXNUT.m
r628 r636 1 ECXNUT ;ALB/JRC Nutrition DSS Extract ; 9/24/07 9:33am2 ;;3.0;DSS EXTRACTS;**92,107 ,105**;Dec 22, 1997;Build 701 ECXNUT ;ALB/JRC Nutrition DSS Extract ; 4/2/2007 2 ;;3.0;DSS EXTRACTS;**92,107**;Dec 22, 1997;Build 9 3 3 BEG ;entry point from option 4 4 N EC23,EC7,ECED,ECFILE,ECGRP,ECHEAD,ECINST,ECPACK,ECPIECE,ECRN,ECRTN,ECSD1,ECVER,ECXYM … … 9 9 START ; start package specific extract 10 10 ;Init variables 11 N ECSD ,ARRAY12 S ECED=ECED+.3,ECSD=ECSD1 ,ARRAY="^TMP($J,""FH"")"13 K @ARRAY11 N ECSD 12 S ECED=ECED+.3,ECSD=ECSD1 13 K ^TMP($J,"FH") 14 14 ; 15 15 ;Call n&fs api and store in ^TMP($J,"FH" global … … 20 20 ; 21 21 ;kill ^tmp global 22 K @ARRAY22 K ^TMP($J,"FH") 23 23 ; 24 24 Q … … 27 27 ;Init variables 28 28 N ECXORDPC,ECXSSN,ECXPNM,ECXSEX,ECXDOB,ECXMPI,ECXRC1,ECXETH,ECXVET,ECXENRL,ECXELIG,ECXMST,ECXPST,ECXPLOC,ECXPHI,ECXMNS,ECXSTATE,ECXCNTY,ECXZIP,ECXPOS,ECXAST,ECXAOL,ECXRST,ECXEST,ECXTM,ECXDATE,ECXMN,ECXSPC 29 N ECXADMDT,ECXWRD,ECXFAC,ECXPRV,ECXPRNPI,ECXATT,ECXATNPI,ECXDOM,ECXATTPC,ECXPRVPC,ECXPDIV,ECXCBOC,ECPTPR,ECCLASS,ECPTTM,ECXOBS,ECXHNCI,ECXNPRFI,ECXERI,ECXENC,ECPAT,ECXERR,ADM,W,X,ECXCAT,ECXCVE,ECXPRIOR,ECXPTYPE,ECXSTAT,ECXUESTA,ECXA,ECORNPI 30 N ECXOEF,ECXOEFDT 29 N ECXADMDT,ECXWRD,ECXFAC,ECXPRV,ECXPRNPI,ECXATT,ECXATNPI,ECXDOM,ECXATTPC,ECXPRVPC,ECXPDIV,ECXCBOC,ECPTPR,ECCLASS,ECPTTM,ECXOBS,ECXHNCI,ECXNPRFI,ECXERI,ECXENC,ECPAT,ECXERR,ADM,W,X,ECXCAT,ECXCVE,ECXPRIOR,ECXPTYPE,ECXSTAT,ECXUESTA,ECXA 31 30 ; 32 31 ;- Prefix ordering pro with a 2 and get person class 33 32 S ECXORDPC=$$PRVCLASS^ECXUTL(+ECXORDPH,DATE) 34 S ECORNPI=$$NPI^XUSNPI("Individual_ID",+ECXORDPH,DATE)35 S:+ECORNPI'>0 ECORNPI="" S ECORNPI=$P(ECORNPI,U)36 33 S ECXORDPH=$S(ECXORDPH:2_ECXORDPH,1:"") 37 34 ; … … 45 42 S ECXPOS=ECPAT("POS"),ECXAST=ECPAT("AO STAT"),ECXAOL=ECPAT("AOL"),ECXRST=ECPAT("IR STAT"),ECXEST=ECPAT("EC STAT") 46 43 ; 47 ;Get oef/oif data48 S ECXOEF=ECPAT("ECXOEF")49 S ECXOEFDT=ECPAT("ECXOEFDT")50 ;51 44 ;Get enrollment status 52 45 I $$ENROLLM^ECXUTL2(ECXDFN) 53 46 ; 54 47 S ECXTM=$$ECXTIME^ECXUTL(DATE) 55 S ECXDATE= $$ECXDATE^ECXUTL(+DATE,ECXYM)48 S ECXDATE=DATE 56 49 ; 57 50 ;- Use movement record date & time … … 67 60 ;- Get primary care data 68 61 S X=$$PRIMARY^ECXUTL2(ECXDFN,DATE) 69 S ECPTPR=$P(X,U,2),ECCLASS=$P(X,U,3),ECPTTM=$P(X,U) ,ECPTNPI=$P(X,U,4)62 S ECPTPR=$P(X,U,2),ECCLASS=$P(X,U,3),ECPTTM=$P(X,U) 70 63 ; 71 64 ;- Observation patient indicator (YES/NO) … … 115 108 ;facility^delivery location type^delivery feeder location^quantity^ 116 109 ;cboc^status^user enrollee^patient type^cv status eligibility^ 117 ;national patient record flag^emergency response indicator^admission 118 ;date^oef/oif ECXOEF^oef/oif return date ECXOEFDT^ordering provider 119 ;npi ECORNPI^primary care provider npi ECPTNPI 110 ;national^patient record flag^emergency response indicator^admission 111 ;date 120 112 ; 121 113 N DA,DIK,ECODE,ECODE1 … … 129 121 S ECXSPC=$G(ECXDATA(7)) 130 122 ; 131 S ECODE=ECODE_ ECXDATE_U_ECXTM_U_ECXSPC_U_ECXORDPH_U_ECXORDPC_U123 S ECODE=ECODE_$$ECXDATE^ECXUTL(DATE,ECXYM)_U_ECXTM_U_ECXSPC_U_ECXORDPH_U_ECXORDPC_U 132 124 S ECODE=ECODE_ECPTPR_U_ECCLASS_U_ECPTTM_U_ECXMPI_U_ECXDOB_U_ECXSEX_U 133 125 S ECODE=ECODE_ECXRC1_U_ECXETH_U_ECXVET_U_ECXSTAT_U_ECXENRL_U_ECXCAT_U … … 139 131 S ECODE1=ECODE1_ECXCBOC_U_ECXUESTA_U_ECXPTYPE_U_ECXCVE_U_ECXNPRFI_U 140 132 S ECODE1=ECODE1_ECXERI_U_$S(ECXADMDT:$$ECXDATE^ECXUTL(ECXADMDT,ECXYM),1:"") 141 I ECXLOGIC>2007 S ECODE1=ECODE1_U_ECXOEF_U_ECXOEFDT_U_$G(ECXTFU)_U_ECORNPI_U_ECPTNPI142 133 S ^ECX(ECFILE,EC7,0)=ECODE,^ECX(ECFILE,EC7,1)=ECODE1 143 134 S ECRN=ECRN+1 -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECXNUT1.m
r628 r636 1 ECXNUT1 ;ALB/JRC Nutrition DSS Extract ; 1 1/23/07 12:27pm2 ;;3.0;DSS EXTRACTS;**92 ,107,105**;Dec 22, 1997;Build 701 ECXNUT1 ;ALB/JRC Nutrition DSS Extract ; 10/27/06 1:53pm 2 ;;3.0;DSS EXTRACTS;**92**;Dec 22, 1997;Build 30 3 3 Q 4 ; 4 5 GETMEALS ;get patient meals 5 ; variable names: ordate - regular diet order date 6 ; sdate - diet order npo/withhold date 7 ; norder - "sf" or "so" order date 8 ; note: there is a relationship 9 ; between "sf", "so" and regular diets 10 ; adate - admission date 11 ; ddate - discharge date 12 N I,J,P,D,ECXADM,FHDFN,ORDATE,DATES,NODE,SF,PRODUCT,ECXQTY,ORDER,ECXORDPH,ECXKEY,ECXFPD,ECXFDD,ECXFPF,ECXDLT,ECXDFL,MEAL,MEALS,SORDATE,NUMBER,TF,TFNODE,ECXTFU,SDATE 13 ;set ecsd to first day of the month before setting meals array 14 S ECSD=ECSD+.1,ECXTFU="" 15 ;setup individual meals array for inpatients 16 F I=ECSD:1:ECED F J=I+.0800,I+.1300,I+.1800 S MEALS(J)=J 17 ;get "inp", "sf", and "so" inpatient meals 18 S ECXADM=0 F S ECXADM=$O(@ARRAY@(ECXADM)) Q:'ECXADM D 19 .S FHDFN=0 F S FHDFN=$O(@ARRAY@(ECXADM,FHDFN)) Q:'FHDFN D 20 ..S ORDATE=0,(ADATE,DDATE,SDATE)="" 21 ..F S ORDATE=$O(@ARRAY@(ECXADM,FHDFN,ORDATE)) Q:'ORDATE D 22 ...Q:$P($G(^TMP($J,"FH",ECXADM,FHDFN,+ORDATE,"INP")),U,7)'="" 23 ...S DATES=$$GETDATES(),SDATE=ORDATE 24 ...;create regular diet individual meals 25 ...S P="INP",D="PD" 26 ...;get new order date and time if exist 27 ...S NORDER=$$NEWORDER(D,ORDATE) 28 ...S NODE=$G(^TMP($J,"FH",ECXADM,FHDFN,ORDATE,"INP")) Q:'NODE 29 ...S PRODUCT=$P(NODE,U,13),ECXQTY=1,ORDER=""_$P(NODE,U,14)_","_"" 30 ...;Resolve feeder key for nutrition product 31 ...S ECXKEY=$$NUTKEY^ECXUTL6(D,PRODUCT) 32 ...I $$NUTLOC^ECXUTL6(P,D,.ECXFPD,.ECXFDD,.ECXFPF,.ECXDLT,.ECXDFL) 33 ...S MEAL=ORDATE F S MEAL=$O(MEALS(MEAL)) Q:'MEAL D 34 ....I $P(DATES,U) Q:MEAL>$P(DATES,U) 35 ....I NORDER]"" Q:MEAL>NORDER 36 ....I $P(DATES,U,3) Q:MEAL>$P(DATES,U,3) 37 ....S ECXORDPH=$$GET1^DIQ(100,+ORDER,1,"I") 38 ....;Get additional data and file record. 39 ....S DATE=MEAL D GET^ECXNUT 40 ;create supplemental feeding meals if they exist 41 S ECXADM=0 F S ECXADM=$O(@ARRAY@(ECXADM)) Q:'ECXADM D 42 .S FHDFN=0 F S FHDFN=$O(@ARRAY@(ECXADM,FHDFN)) Q:'FHDFN D 43 ..S ORDATE=0,(ADATE,DDATE,SDATE)="" 44 ..F S ORDATE=$O(@ARRAY@(ECXADM,FHDFN,ORDATE)) Q:'ORDATE D 45 ...S DATES=$$GETDATES() 46 ...;get "sf" orders if they exist 47 ...N SFNODE S (SFNODE,ECXORDPH,CDATE)="" 48 ...S SFNODE=$G(@ARRAY@(ECXADM,FHDFN,ORDATE,"SF")) 49 ...I +SFNODE D 50 ....S P="INP",D="SF" 51 ....;get new order date and time if exist 52 ....S NORDER=$$NEWORDER(D,ORDATE),CDATE=$P(SFNODE,U,32) 53 ....;order thru all "sf" product fields and generate records 54 ....F SF=5:2:27 S PRODUCT=$P(SFNODE,U,SF) S ECXQTY=$P(SFNODE,U,(SF+1)) D 55 .....Q:PRODUCT']"" 56 .....;Resolve external value for product key 57 .....S ECXKEY=$$NUTKEY^ECXUTL6("SF",PRODUCT) 58 .....I $$NUTLOC^ECXUTL6(P,D,.ECXFPD,.ECXFDD,.ECXFPF,.ECXDLT,.ECXDFL) 59 .....;create individual meals 60 .....F MEAL=ECSD:1:ECED D 61 ......I CDATE]"" Q:MEAL>CDATE 62 ......I NORDER]"" Q:MEAL>NORDER 63 ......I $P(DATES,U,3)]"" Q:MEAL>$P(DATES,U,3) 64 ......;Get additional data and file record. 65 ......S DATE=$P(MEAL,".")_"."_$S("57911"[SF:10,"13151719"[SF:14,1:18) 66 ......D GET^ECXNUT 67 ;create standing order meals if they exist 68 S ECXADM=0 F S ECXADM=$O(@ARRAY@(ECXADM)) Q:'ECXADM D 69 .S FHDFN=0 F S FHDFN=$O(@ARRAY@(ECXADM,FHDFN)) Q:'FHDFN D 70 ..S ORDATE=0,(ADATE,DDATE,SDATE)="" 71 ..F S ORDATE=$O(@ARRAY@(ECXADM,FHDFN,ORDATE)) Q:'ORDATE D 72 ...S DATES=$$GETDATES() 73 ...N SONODE,NUM S (SONODE,ECXORDPH)="",NUM=0 74 ...S NUM=$O(@ARRAY@(ECXADM,FHDFN,ORDATE,"SO",NUM)) Q:'NUM D 75 ....S SONODE=$G(@ARRAY@(ECXADM,FHDFN,ORDATE,"SO",NUM)) 76 ....I +SONODE D 77 .....;create standing order meals 78 .....N SMEAL S P="INP",D="SO" 79 .....;get new order date and time if exist 80 .....S NORDER=$$NEWORDER(D,ORDATE),SMEAL=$P(SONODE,U,3) 81 .....S PRODUCT=$P(SONODE,U,2),ECXQTY=$P(SONODE,U,8) 82 .....;Resolve feeder key for nutrition product 83 .....S ECXKEY=$$NUTKEY^ECXUTL6(D,PRODUCT) 84 .....I $$NUTLOC^ECXUTL6(P,D,.ECXFPD,.ECXFDD,.ECXFPF,.ECXDLT,.ECXDFL) 85 .....;create individual meals 86 .....S MEAL=ORDATE F S MEAL=$O(MEALS(MEAL)) Q:'MEAL D 87 ......N TIME S TIME=$P(MEALS(MEAL),".",2) 88 ......Q:SMEAL'["B"&(TIME=08) 89 ......Q:SMEAL'["N"&(TIME=13) 90 ......Q:SMEAL'["E"&(TIME=18) 91 ......I $P(DATES,U) Q:MEAL>$P(DATES,U) 92 ......I NORDER]"" Q:MEAL>NORDER 93 ......I $P(DATES,U,3) Q:MEAL>$P(DATES,U,3) 94 ......;Get additional data and file record. 95 ......S DATE=MEAL D GET^ECXNUT 96 ;remove individual meals array 97 K MEALS 6 ;init variables 7 N DATE,FHDFN,ECXADM,NODE,PRODUCT,ECXQTY,ORDER,ECXORDPH,ECXKEY,P,D 8 N ECXFPD,ECXFDD,ECXFPF,ECXDLT,ECXDFL,NUMBER,PNODE,SF,TF,TFNODE 9 ;S (DATE,FHDFN,NUMBER,ECXQTY)=0,(ECXADM,NODE,ORDER,ECXORDPH)="" 10 ;Get inpatient diets 11 ;S P="INP",D="PD" F S DATE=$O(^TMP($J,"FH",DATE)) Q:'DATE D 12 ;. F S FHDFN=$O(^TMP($J,"FH",DATE,FHDFN)) Q:'FHDFN D 13 ;.. F S ECXADM=$O(^TMP($J,"FH",DATE,FHDFN,ECXADM)) Q:'ECXADM D 14 ;... S NODE=$G(^TMP($J,"FH",DATE,FHDFN,ECXADM,"INP")) Q:'NODE 15 ;... S PRODUCT=$P(NODE,U,13),ECXQTY=1,ORDER=""_$P(NODE,U,14)_","_"" 16 ;... S ECXORDPH=$$GET1^DIQ(100,+ORDER,1,"I") 17 ;... ;Resolve feeder key for nutrition product 18 ;... S ECXKEY=$$NUTKEY^ECXUTL6("PD",PRODUCT) 19 ;... I $$NUTLOC^ECXUTL6(P,D,.ECXFPD,.ECXFDD,.ECXFPF,.ECXDLT,.ECXDFL) 20 ;... ;Get additional data and file record. 21 ;... D GET^ECXNUT 22 ;Get inpatient supplemental feedings 23 ;S (FHDFN,DATE)=0,(ECXADM,NODE,ORDER,ECXORDPH)="" 24 ;S P="INP",D="SF" F S DATE=$O(^TMP($J,"FH",DATE)) Q:'DATE D 25 ;. F S FHDFN=$O(^TMP($J,"FH",DATE,FHDFN)) Q:'FHDFN D 26 ;.. F S ECXADM=$O(^TMP($J,"FH",DATE,FHDFN,ECXADM)) Q:'ECXADM D 27 ;... S NODE=$G(^TMP($J,"FH",DATE,FHDFN,ECXADM,"SF")) Q:'NODE 28 ;... F SF=5:2:27 S PRODUCT=$P(NODE,U,SF) Q:PRODUCT']"" S ECXQTY=1 D 29 ;.... S ORDER=""_$P(NODE,U,7)_","_"" 30 ;.... S ECXORDPH=$$GET1^DIQ(100,ORDER,1,"I") 31 ;.... ;Resolve external value for product key 32 ;.... S ECXKEY=$$NUTKEY^ECXUTL6("SF",PRODUCT) 33 ;.... I $$NUTLOC^ECXUTL6(P,D,.ECXFPD,.ECXFDD,.ECXFPF,.ECXDLT,.ECXDFL) 34 ;.... ;Get additional data and file record. 35 ;.... D GET^ECXNUT 36 ;Get inpatient standing orders 37 ;S (FHDFN,DATE)=0,(ECXADM,NODE,ECXORDPH)="" 38 ;S P="INP",D="SO" F S DATE=$O(^TMP($J,"FH",DATE)) Q:'DATE D 39 ;. F S FHDFN=$O(^TMP($J,"FH",DATE,FHDFN)) Q:'FHDFN D 40 ;.. F S ECXADM=$O(^TMP($J,"FH",DATE,FHDFN,ECXADM)) Q:'ECXADM D 41 ;... S NODE=$G(^TMP($J,"FH",DATE,FHDFN,ECXADM,"SO")) Q:'NODE 42 ;... S PRODUCT=$P(NODE,U,2),ECXQTY=1 43 ;... ;Resolve external value for product key 44 ;... S ECXKEY=$$NUTKEY^ECXUTL6("SO",PRODUCT) 45 ;... I $$NUTLOC^ECXUTL6(P,D,.ECXFPD,.ECXFDD,.ECXFPF,.ECXDLT,.ECXDFL) 46 ;... ;Get additional data and file record. 47 ;... D GET^ECXNUT 98 48 ;Get inpatient tube feedings 99 N P1,PNODE,CDATE,ECXTFU,MEALS 100 ;set daily meals array for inpatient tube feedings 101 F I=ECSD:1:ECED S MEALS(I)="" 102 S (FHDFN,DATE,P1,CDATE)=0,(ECXADM,NODE,ECXORDPH,PNODE)="" 103 S P="INP",D="TF" F S ECXADM=$O(^TMP($J,"FH",ECXADM)) Q:'ECXADM D 104 .F S FHDFN=$O(^TMP($J,"FH",ECXADM,FHDFN)) Q:'FHDFN D 105 ..F S DATE=$O(^TMP($J,"FH",ECXADM,FHDFN,DATE)) Q:'DATE D 106 ...S NODE=$G(^TMP($J,"FH",ECXADM,FHDFN,DATE,"TF")) Q:'NODE D 107 ....F S P1=$O(^TMP($J,"FH",ECXADM,FHDFN,DATE,"TF",P1)) Q:'P1 D 108 .....S PNODE=^TMP($J,"FH",ECXADM,FHDFN,DATE,"TF",P1,"P") 109 .....S ORDATE=DATE,DATES=$$GETDATES(),CDATE=$P(NODE,U,11) 110 .....S PRODUCT=$P(PNODE,U,1),ORDER=""_$P(NODE,U,14)_","_"" 111 .....S ECXQTY=$S($P(PNODE,U,3)["GM":$P(PNODE,U,3),1:$P(PNODE,U,4)) 112 .....S ECXTFU=$S($P(PNODE,U,3)["GM":"GM",1:"ML") 113 .....;Resolve external value for product key 114 .....S ECXKEY=$$NUTKEY^ECXUTL6(D,PRODUCT) 115 .....I $$NUTLOC^ECXUTL6(P,D,.ECXFPD,.ECXFDD,.ECXFPF,.ECXDLT,.ECXDFL) 116 .....;create daily meals 117 .....S MEAL=DATE F S MEAL=$O(MEALS(MEAL)) Q:'MEAL D 118 ......I $P(DATES,U) Q:MEAL>$P(DATES,U) 119 ......I CDATE]"" Q:MEAL>CDATE 120 ......I $P(DATES,U,3) Q:MEAL>$P(DATES,U,3) 121 ......S ECXORDPH=$$GET1^DIQ(100,ORDER,1,"I") 122 ......;Get additional data and file record. 123 ......S DATE=MEAL D GET^ECXNUT S DATE=ORDATE 49 ;S (FHDFN,DATE,P)=0,(ECXADM,NODE,ECXORDPH,PNODE)="" 50 ;S P="INP",D="TF" F S DATE=$O(^TMP($J,"FH",DATE)) Q:'DATE D 51 ;. F S FHDFN=$O(^TMP($J,"FH",DATE,FHDFN)) Q:'FHDFN D 52 ;.. F S ECXADM=$O(^TMP($J,"FH",DATE,FHDFN,ECXADM)) Q:'ECXADM D 53 ;... S NODE=$G(^TMP($J,"FH",DATE,FHDFN,ECXADM,"TF")) Q:'NODE 54 ;... S P=$O(^TMP($J,"FH",DATE,FHDFN,ECXADM,"TF",P)) Q:'P D 55 ;.... S PNODE=^TMP($J,"FH",DATE,FHDFN,ECXADM,"TF",P,"P") 56 ;.... S PRODUCT=$P(PNODE,U,1),ECXQTY=$P(PNODE,U,4) 57 ;.... S ORDER=""_$P(NODE,U,14)_","_"" 58 ;.... S ECXORDPH=$$GET1^DIQ(100,ORDER,1,"I") 59 ;.... ;Resolve external value for product key 60 ;.... S ECXKEY=$$NUTKEY^ECXUTL6("TF",PRODUCT) 61 ;.... I $$NUTLOC^ECXUTL6(P,D,.ECXFPD,.ECXFDD,.ECXFPF,.ECXDLT,.ECXDFL) 62 ;.... ;Get additional data and file record. 63 ;.... D GET^ECXNUT 124 64 ;Get outpatient recurring meals 125 S DATE=0,(ECXADM,NODE,ECXORDPH,ECXTFU)=""65 S (FHDFN,DATE)=0,(ECXADM,NODE,ECXORDPH)="" 126 66 S P="OP",D="RM" F S DATE=$O(^TMP($J,"FH",DATE)) Q:'DATE D 127 . S FHDFN=0F S FHDFN=$O(^TMP($J,"FH",DATE,FHDFN)) Q:'FHDFN D67 . F S FHDFN=$O(^TMP($J,"FH",DATE,FHDFN)) Q:'FHDFN D 128 68 .. S NUMBER=0 F S NUMBER=$O(^TMP($J,"FH",DATE,FHDFN,NUMBER)) Q:'NUMBER D 129 69 ... S NODE=$G(^TMP($J,"FH",DATE,FHDFN,NUMBER,"RM")) Q:'NODE … … 137 77 ... D GET^ECXNUT 138 78 ;Get outpatient tube feedings 139 S DATE=0,(ECXADM,NODE,ECXORDPH)=""79 S (FHDFN,DATE,NUMBER)=0,(ECXADM,NODE,ECXORDPH)="" 140 80 S P="OP",D="TF" F S DATE=$O(^TMP($J,"FH",DATE)) Q:'DATE D 141 . S FHDFN=0F S FHDFN=$O(^TMP($J,"FH",DATE,FHDFN)) Q:'FHDFN D142 .. S NUMBER=0F S NUMBER=$O(^TMP($J,"FH",DATE,FHDFN,NUMBER)) Q:'NUMBER D143 ... S NODE=$G(^TMP($J,"FH",DATE,FHDFN,NUMBER,"RMTF")) Q: NODE=""144 ... S TF= 0 F S TF=$O(^TMP($J,"FH",DATE,FHDFN,NUMBER,"RMTF",TF)) Q:'TF D81 . F S FHDFN=$O(^TMP($J,"FH",DATE,FHDFN)) Q:'FHDFN D 82 .. F S NUMBER=$O(^TMP($J,"FH",DATE,FHDFN,NUMBER)) Q:'NUMBER D 83 ... S NODE=$G(^TMP($J,"FH",DATE,FHDFN,NUMBER,"RMTF")) Q:'NODE 84 ... S TF=$O(^TMP($J,"FH",DATE,FHDFN,NUMBER,"RMTF",TF)) Q:'TF D 145 85 .... S TFNODE=^TMP($J,"FH",DATE,FHDFN,NUMBER,"RMTF",TF) 146 86 .... S PRODUCT=$P(TFNODE,U,1),ECXQTY=$P(TFNODE,U,4) … … 155 95 . F S FHDFN=$O(^TMP($J,"FH",DATE,FHDFN)) Q:'FHDFN D 156 96 .. S NODE=$G(^TMP($J,"FH",DATE,FHDFN,"SM")) Q:'NODE 157 .. S PRODUCT=$P(NODE,U,4),ECXQTY=1,ECXORDPH=$P(NODE,U,5) 158 .. S PRODUCT=$$GET1^DIQ(111,PRODUCT,4,"I") 97 .. S PRODUCT=$P(NODE,U,13),ECXQTY=1,ECXORDPH=$P(NODE,U,5) 159 98 .. ;Resolve external value for product key 160 99 .. S ECXKEY=$$NUTKEY^ECXUTL6("SM",PRODUCT) … … 174 113 .. D GET^ECXNUT 175 114 Q 176 GETDATES() ;Get admit, discharge, npo/withhold dates,for "inp", "sf" and "so"177 ; return in string i.e. stop date^admission date^discharge date178 ; input: ecxadm - movement file ien179 ; fhdfn - nutrition patient file (#115)180 ;181 ; output: stop date - npo/withhold date182 ; admit date - admission date and time183 ; discharge date - discharge date and time184 ;init variables185 N ADATE,DDATE,DATE,STDATE,NORDATE,IENS186 ;check input187 Q:'$G(ECXADM)!'$G(FHDFN) "0^0^0"188 ;get admission and discharge dates189 S (ADATE,DDATE,DATE,SDATE,NORDATE,STDATE)="",IENS=""_ECXADM_","_FHDFN_","_"",ADATE=$$GET1^DIQ(115.01,IENS,.01,"I"),DDATE=$$GET1^DIQ(115.01,IENS,18,"I")190 ;get "inp" order's npo/withhold date return it as 'stdate' if exist191 S DATE=ORDATE F S DATE=$O(@ARRAY@(ECXADM,FHDFN,DATE)) Q:'DATE D192 .I $P($G(@ARRAY@(ECXADM,FHDFN,+DATE,"INP")),U,7)'="" S STDATE=DATE193 Q STDATE_U_ADATE_U_DDATE194 NEWORDER(TYPE,DATE) ;Look for new order for inpatient meal type if exist195 ; Input ecxadm - movement #196 ; fhdfn - nutrition file (#115) fhdfn197 ; date - starting order date to begin lookup198 ; type - meal type "sf", "so", or "pd"199 ; Output: new order date and time for specific meal type200 ;init variables201 N NORDER202 S NORDER=""203 ;check input204 Q:$G(TYPE)']""!'$G(DATE) NORDER205 F S DATE=$O(@ARRAY@(ECXADM,FHDFN,DATE)) Q:'DATE Q:NORDER D206 .S NODE=$G(^TMP($J,"FH",ECXADM,FHDFN,DATE,TYPE)) Q:'NODE207 .S NORDER=DATE208 Q NORDER -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECXOPRX.m
r628 r636 1 ECXOPRX ;ALB/JAP,BIR/DMA,CML,PTD-Prescription Extract for DSS ; 11/ 5/07 8:17am2 ;;3.0;DSS EXTRACTS;**10,11,8,13,24,30,33,38,39,46,49,71,81,84,92 ,105**;Dec 22, 1997;Build 701 ECXOPRX ;ALB/JAP,BIR/DMA,CML,PTD-Prescription Extract for DSS ; 11/2/06 8:42am 2 ;;3.0;DSS EXTRACTS;**10,11,8,13,24,30,33,38,39,46,49,71,81,84,92**;Dec 22, 1997;Build 30 3 3 ; 4 4 BEG ;entry point from option … … 41 41 ;- Get provider (either 2_provider or 6_provider depending on version) 42 42 S ECXPROV=$S($P(ECDATA,U,4)'="":ECPROF_$P(ECDATA,U,4),1:""),ECXPROVP=$$PRVCLASS^ECXUTL($P(ECDATA,U,4),ECXDATE) 43 S ECPRVNPI=$$NPI^XUSNPI("Individual_ID",$P(ECDATA,U,4),ECXDATE)44 S:+ECPRVNPI'>0 ECPRVNPI="" S ECPRVNPI=$P(ECPRVNPI,U)45 43 ;get classification data 46 44 S ECXCLS=$G(^PSRX(ECRX,"IBQ")),ECXMIL=$P(ECXCLS,U,2),ECXAO=$P(ECXCLS,U,3),ECXIR=$P(ECXCLS,U,4),ECXECE=$P(ECXCLS,U,5),ECXHNC=$P(ECXCLS,U,6) … … 86 84 PAT(ECXDFN,ECXDATE,ECXERR) ;Determine in/outpatient status, movement number, primary care team and provider 87 85 N OK,X,PT 88 S (ECXCAT,ECXSTAT,ECXPRIOR,ECXSBGRP ,ECXOEF,ECXOEFDT)=""86 S (ECXCAT,ECXSTAT,ECXPRIOR,ECXSBGRP)="" 89 87 ;get patient data if saved 90 88 I $D(^TMP($J,"ECXP",ECXDFN)) D … … 94 92 .S ECXPHI=$P(PT,U,20),ECXCAT=$P(PT,U,21),ECXSTAT=$P(PT,U,22),ECXPRIOR=$P(PT,U,23) 95 93 .S ECXCNHU=$P(PT,U,24),ECXPOS=$P(PT,U,25),ECXAOL=$P(PT,U,26),ECXHNCI=$P(PT,U,27),ECXETH=$P(PT,U,28),ECXRC1=$P(PT,U,29),ECXMTST=$P(PT,U,30) 96 .S PT1=$G(^TMP($J,"ECXP",ECXDFN,1)),ECXERI=$P(PT1,U),ECXEST=$P(PT1,U,2) ,ECXOEF=$P(PT1,U,3),ECXOEFDT=$P(PT1,U,4)94 .S PT1=$G(^TMP($J,"ECXP",ECXDFN,1)),ECXERI=$P(PT1,U),ECXEST=$P(PT1,U,2) 97 95 .I $$ENROLLM^ECXUTL2(ECXDFN) 98 96 ;set patient data … … 110 108 .S ECXHNCI=$$HNCI^ECXUTL4(ECXDFN) ;Head and Neck Cancer Indicator 111 109 .S ECXETH=ECXPAT("ETHNIC"),ECXRC1=ECXPAT("RACE1") ;Race and Ethnicity 112 .; OEF/OIF data113 .S ECXOEF=ECXPAT("ECXOEF")114 .S ECXOEFDT=ECXPAT("ECXOEFDT")115 110 .S ^TMP($J,"ECXP",ECXDFN)=ECXSSN_U_ECXPNM_U_ECXMPI_U_ECXSEX_U_ECXDOB_U_ECXELIG_U_ECXVET_U_ECXRACE_U_ECXPST_U_ECXPLOC_U_ECXRST_U_ECXAST_U_ECXMST_U_ECXSTATE_U_ECXCNTY_U_ECXZIP_U_ECXENRL_U_U 116 111 .S ^TMP($J,"ECXP",ECXDFN)=^TMP($J,"ECXP",ECXDFN)_U_ECXPHI_U_ECXCAT_U_ECXSTAT_U_ECXPRIOR_U_ECXCNHU_U_ECXPOS_U_ECXAOL_U_ECXHNCI_U_ECXETH_U_ECXRC1_U_ECXMTST 117 .S ^TMP($J,"ECXP",ECXDFN,1)=ECXERI_U_ECXEST _U_ECXOEF_U_ECXOEFDT112 .S ^TMP($J,"ECXP",ECXDFN,1)=ECXERI_U_ECXEST 118 113 ;get inpatient data 119 114 S (ECXA,ECXADMDT,ECXDOM,ECXMN,ECXTS)="",X=$$INP^ECXUTL2(ECXDFN,ECXDATE) D -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECXOPRX1.m
r628 r636 1 ECXOPRX1 ;ALB/JAP,BIR/DMA,CML,PTD-Prescription Extract for DSS ; 6/6/07 7:23am2 ;;3.0;DSS EXTRACTS;**92,107 ,105**;Dec 22, 1997;Build 701 ECXOPRX1 ;ALB/JAP,BIR/DMA,CML,PTD-Prescription Extract for DSS ; 4/19/2007 2 ;;3.0;DSS EXTRACTS;**92,107**;Dec 22, 1997;Build 9 3 3 ; 4 4 FILE ;file record … … 8 8 ;feeder key^investigational^days supply^primary care team^primary care provider^time^race 9 9 ;node1 10 ;mpi^dss dept ECXDSSD^sex^zip+4^p laceholder^placeholder^state^county^pc prov person class^pow status^pow location^10 ;mpi^dss dept ECXDSSD^sex^zip+4^provider npi^pc provider npi^state^county^pc prov person class^pow status^pow location^ 11 11 ;ir status^ao status^sharing agree. payor^sharing agree. ins.^mst status^enroll loc^assoc pc provider^assoc pc prov person class^ 12 ; placeholder^dom ECXDOM^purple heart ECXPHI^enrollment category ECXCAT^enrollment status ECXSTST^12 ;assoc pc prov npi^dom ECXDOM^purple heart ECXPHI^enrollment category ECXCAT^enrollment status ECXSTST^ 13 13 ;enrollment priority ECXPRIOR^cnhu status ECXCNHU^period of service ECXPOS^observ pat ind ECXOBS^encounter num ECXENC^ 14 14 ;ao loc ECXAOL^ord physician ECXORDPH^ord stop code ECXORDST^ord date ECXORDDT^CNH status ECXCNH^national division ECXPDIV^ … … 17 17 ;enc cv eligible ECXCVENC^national patient record flag ECXNPRFI^rx patient status ECRXPTST^non-va prescriber ECNONVAP^rx # ECRXNUM 18 18 ;^emergency response indicator(FEMA) ECXERI^agent orange enc ECXAO^environ cont PGE ECXECE^head/neck ECXHNC^enc mst ECXMIL^environ contamin ECXEST^ion radiat ECXIR 19 ;OEF/OIF data ECXOEF^OEFOIF return date ECXOEFDT^associate pc provider npi ECASNPI^primary care provider npi ECPTNPI^provider npi ECPRVNPI20 19 N DA,DIK 21 20 S EC7=$O(^ECX(ECFILE,999999999),-1),EC7=EC7+1 … … 31 30 S ECODE=ECODE_ECXELIG_U_ECXVET_U_ECOPAY_U_ECNFC_U_ECINV_U_ECDS_U 32 31 S ECODE=ECODE_ECPTTM_U_ECPTPR_U_$$ECXTIME^ECXUTL(ECXDATE)_U_ECXRACE_U 33 S ECODE1=ECXMPI_U_ECXDSSD_U_ECXSEX_U_ECXZIP_U_ECXPROVN_U_ U32 S ECODE1=ECXMPI_U_ECXDSSD_U_ECXSEX_U_ECXZIP_U_ECXPROVN_U_ECPTNPI_U 34 33 S ECODE1=ECODE1_ECXSTATE_U_ECXCNTY_U_ECCLAS_U_ECXPST_U_ECXPLOC_U 35 34 S ECODE1=ECODE1_ECXRST_U_ECXAST_U_U_U_ECXMST_U_ECXENRL_U 36 S ECODE1=ECODE1_ECASPR_U_ECCLAS2_U_ U_ECXDOM_U_ECXPHI_U_ECXCAT_U35 S ECODE1=ECODE1_ECASPR_U_ECCLAS2_U_ECASNPI_U_ECXDOM_U_ECXPHI_U_ECXCAT_U 37 36 S ECODE1=ECODE1_ECXSTAT_U_$S(ECXLOGIC<2005:ECXPRIOR,1:"")_U_ECXCNHU_U_ECXPOS_U_ECXOBS_U 38 37 S ECODE1=ECODE1_ECXENC_U_ECXAOL_U_ECXORDPH_U_ECXORDST_U_ECXORDDT_U … … 43 42 I ECXLOGIC>2005 S ECODE2=ECODE2_U_ECRXNUM 44 43 I ECXLOGIC>2006 S ECODE2=ECODE2_U_ECXERI_U_ECXAO_U_ECXECE_U_ECXHNC_U_ECXMIL_U_ECXEST_U_ECXIR_U_ECXSCRX 45 I ECXLOGIC>2007 S ECODE2=ECODE2_U_ECXOEF_U_ECXOEFDT_U_ECASNPI_U_ECPTNPI_U_ECPRVNPI46 44 S ^ECX(ECFILE,EC7,0)=ECODE,^ECX(ECFILE,EC7,1)=ECODE1,^ECX(ECFILE,EC7,2)=$G(ECODE2),ECRN=ECRN+1 47 45 S DA=EC7,DIK="^ECX("_ECFILE_"," D IX1^DIK K DIK,DA -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECXPIVDN.m
r628 r636 1 ECXPIVDN ;ALB/JAP,BIR/DMA,CML,PTD-Extract from IV EXTRACT DATA File (#728.113) ; 10/31/07 1:38pm 2 ;;3.0;DSS EXTRACTS;**10,11,8,13,24,33,39,46,49,71,84,96,92,107,105**;Dec 22, 1997;Build 70 3 BEG ;entry point from option 4 D SETUP I ECFILE="" Q 5 D ^ECXTRAC,^ECXKILL 6 Q 7 ; 1 ECXPIVDN ;ALB/JAP,BIR/DMA,CML,PTD-Extract from IV EXTRACT DATA File (#728.113) ; 4/19/2007 2 ;;3.0;DSS EXTRACTS;**10,11,8,13,24,33,39,46,49,71,84,96,92,107**;Dec 22, 1997;Build 9 8 3 START ; start package specific extract 9 4 N DIC,DA,DR,DIQ,DFN,ECXNPRFI,ECXPHA … … 58 53 I $L(ECNFC)=12 S ECNFC=$$RJ^XLFSTR(P1,4,0)_$$RJ^XLFSTR(P3,3,0)_ECNFC 59 54 ;- Ordering provider ("2"_provider) 60 S ECXORDPR=$S(+$P(EC,U,10):"2"_$P(EC,U,10),1:"") 61 N ECXUSRTN 62 S ECXUSRTN=$$NPI^XUSNPI("Individual_ID",$P(EC,U,10),$P(EC,U,16)) 63 S:+ECXUSRTN'>0 ECXUSRTN="" S ECXOPNPI=$P(ECXUSRTN,U) 55 S ECXORDPR=$S(+$P(EC,U,10):"2"_$P(EC,U,10),1:""),ECXOPNPI="" 64 56 S ECXORDDT=$P(EC,U,16) ;- Ordering date 65 57 ;- Requesting physician (null for FY2002) … … 83 75 ;set national patient record flag if exist 84 76 S ECXDFN=DFN D NPRF^ECXUTL5 K ECXDFN 85 D:ECXENC'="" FILE ^ECXPIVD2K P1,P377 D:ECXENC'="" FILE K P1,P3 86 78 Q 87 79 PAT(ECXDFN,ECXDATE,ECXERR) ;get patient demographics, primary care, and inpatient data 88 80 N X 89 S (ECXCAT,ECXSTAT,ECXPRIOR,ECXSBGRP ,ECXOEF,ECXOEFDT)=""81 S (ECXCAT,ECXSTAT,ECXPRIOR,ECXSBGRP)="" 90 82 ;get patient data if saved 91 83 I $D(^TMP($J,"ECXP",ECXDFN)) D … … 95 87 .S ECXAOL=$P(PT,U,16),ECXPHI=$P(PT,U,17),ECXMST=$P(PT,U,18),ECXENRL=$P(PT,U,19),ECXCNHU=$P(PT,U,20),ECXCAT=$P(PT,U,21) 96 88 .S ECXSTAT=$P(PT,U,22),ECXPRIOR=$P(PT,U,23),ECXHNCI=$P(PT,U,24),ECXETH=$P(PT,U,25),ECXRC1=$P(PT,U,26),ECXMTST=$P(PT,U,27) 97 .S PT1=$G(^TMP($J,"ECXP",ECXDFN,1)),ECXERI=$P(PT1,U),ECXEST=$P(PT1,U,2) ,ECXOEF=$P(PT1,U,3),ECXOEFDT=$P(PT1,U,4)89 .S PT1=$G(^TMP($J,"ECXP",ECXDFN,1)),ECXERI=$P(PT1,U),ECXEST=$P(PT1,U,2) 98 90 .I $$ENROLLM^ECXUTL2(ECXDFN) 99 91 ;set patient data … … 113 105 .S ECXETH=ECXPAT("ETHNIC"),ECXRC1=ECXPAT("RACE1") 114 106 .S ECXERI=ECXPAT("ERI") ;emergency response indicator (FEMA) 115 .S ECXOEF=ECXPAT("ECXOEF")116 .S ECXOEFDT=ECXPAT("ECXOEFDT")117 107 .;save for later 118 108 .S ^TMP($J,"ECXP",ECXDFN)=ECXPNM_U_ECXSSN_U_ECXMPI_U_ECXDOB_U_ECXELIG_U_ECXSEX_U_ECXSTATE_U_ECXCNTY_U_ECXZIP_U_ECXVET_U_ECXPOS_U_ECXPST_U_ECXPLOC_U_ECXRST_U_ECXAST 119 109 .S ^TMP($J,"ECXP",ECXDFN)=^TMP($J,"ECXP",ECXDFN)_U_ECXAOL_U_ECXPHI_U_ECXMST_U_ECXENRL_U_ECXCNHU_U_ECXCAT_U_ECXSTAT_U_ECXPRIOR_U_ECXHNCI_U_ECXETH_U_ECXRC1_U_ECXMTST 120 .S ^TMP($J,"ECXP",ECXDFN,1)=ECXERI_U_ECXEST _U_ECXOEF_U_ECXOEFDT110 .S ^TMP($J,"ECXP",ECXDFN,1)=ECXERI_U_ECXEST 121 111 ;get primary care data 122 112 S X=$$PRIMARY^ECXUTL2(ECXDFN,$P(ECXDATE,".")) … … 125 115 S (ECXA,ECXMN,ECXADM,ECXTS,ECXW,ECXDIV)="",X=$$INP^ECXUTL2(ECXDFN,ECXDATE) 126 116 S ECXA=$P(X,U),ECXMN=$P(X,U,2),ECXTS=$P(X,U,3),ECXADM=$P(X,U,4),W=$P(X,U,9),ECXDOM=$P(X,U,10),ECXW=$P(W,";"),ECXDIV=$P(W,";",2) 117 Q 118 FILE ;file record 119 ;node0 120 ;fac^dfn^ssn^name^i/o^day^va class^qty^ward^cost^movement #^treat spec^ndc^investigational^iv dispensing fee^new feeder key^total doses^ 121 ;primary care team^primary care provider^ivp time^adm date^adm time^dss identifier 122 ;node1 123 ;mpi^dss dept^pc provider npi^pc prov person class^assoc pc provider^assoc pc prov person class^assoc pc prov npi^dom^obs pat ind^enc num^ 124 ;ord pr^ordering stop code^ord dt^req phys^nat prod division^means tst^elig^dob^sex^state^county^zip+4^vet^period of svc^pow stat^pow loc^ir stat^ao stat^ 125 ;ao loc^purple heart ind.^mst stat^enrollment loc^enrollment cat^enrollment stat^enrollment prior^cnh/sh stat^ord pr npi 126 ;node2 127 ;head & neck cancer ind.^ethnicity^race1^bcma drug dispensed^bcma dose given^bcma unit of administration^bcma ICU flag^ 128 ;ordering provider person class^^user enrollee ECXUESTA^patient type ECXPTYPE^combat vet elig ECXCVE^ 129 ;combat vet elig end date ECXCVEDT^enc cv eligible ECXCVENC^national patient record flag ECXNPRFI^emerg resp indic(FEMA) ECXERI^ 130 ;environ contamin ECXEST 131 N DA,DIK 132 S EC7=$O(^ECX(ECFILE,999999999),-1),EC7=EC7+1 133 S ECODE=EC7_U_EC23_U_ECXDIV_U_DFN_U_ECXSSN_U_ECXPNM_U_ECXA_U 134 S ECODE=ECODE_$$ECXDATE^ECXUTL(ECD,ECXYM)_U_ECVACL_U_ECXCNT_U_ECXW_U 135 ;convert specialty to PTF Code for transmission 136 N ECXDATA 137 S ECXDATA=$$TSDATA^DGACT(42.4,+ECXTS,.ECXDATA) 138 S ECXTS=$G(ECXDATA(7)) 139 ;done 140 S ECODE=ECODE_ECXCOST_U_ECXMN_U_ECXTS_U_ECNDC_U_ECINV_U_ECTYP_U_ECNFC_U 141 S ECODE=ECODE_ECST_U_ECPTTM_U_ECPTPR_U_ECDTTM_U_$$ECXDATE^ECXUTL(ECXADM,ECXYM)_U_$$ECXTIME^ECXUTL(ECXADM)_U_ECXDSSI_U 142 ;if outpat and not observ patient, admit date="" and admit time="000000" 143 I ECXA="O",(ECXOBS="NO") S $P(ECODE,U,24)="",$P(ECODE,U,25)="000000" 144 S ECODE1=ECXMPI_U_ECXDSSD_U_ECPTNPI_U_ECCLAS_U_ECASPR_U_ECCLAS2_U_ECASNPI_U_ECXDOM_U_ECXOBS_U_ECXENC_U_ECXORDPR_U 145 S ECODE1=ECODE1_ECXORDST_U_$$ECXDATE^ECXUTL(ECXORDDT,ECXYM)_U_ECXRPHY_U_ECXPDIV_U_ECXMTST_U_ECXELIG_U_ECXDOB_U 146 S ECODE1=ECODE1_ECXSEX_U_ECXSTATE_U_ECXCNTY_U_ECXZIP_U_ECXVET_U_ECXPOS_U_ECXPST_U_ECXPLOC_U_ECXRST_U_ECXAST_U 147 S ECODE1=ECODE1_ECXAOL_U_ECXPHI_U_ECXMST_U_ECXENRL_U_ECXCAT_U 148 S ECODE1=ECODE1_ECXSTAT_U_$S(ECXLOGIC<2005:ECXPRIOR,1:"")_U_ECXCNHU_U_ECXOPNPI_U 149 S ECODE2=ECXHNCI_U_ECXETH_U_ECXRC1 150 I ECXLOGIC>2003 D 151 .S ECODE2=ECODE2_U_ECXBCDD_U_ECXBCDG_U_ECXBCUA_U_ECXBCIF_U_ECXOPPC 152 I ECXLOGIC>2004 S ECODE2=ECODE2_U_U_ECXPRIOR_ECXSBGRP_U_ECXUESTA_U_ECXPTYPE_U_ECXCVE_U_ECXCVEDT_U_ECXCVENC_U_ECXNPRFI 153 I ECXLOGIC>2006 S ECODE2=ECODE2_U_ECXERI_U_ECXEST 154 S ^ECX(ECFILE,EC7,0)=ECODE,^ECX(ECFILE,EC7,1)=ECODE1 155 S ^ECX(ECFILE,EC7,2)=ECODE2,ECRN=ECRN+1 156 S DA=EC7,DIK="^ECX("_ECFILE_"," D IX^DIK K DIK,DA 157 I $D(ZTQUEUED),$$S^%ZTLOAD S QFLG=1 127 158 Q 128 159 SETUP ;Set required input for ECXTRAC -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECXPLBB.m
r628 r636 1 ECXPLBB ;DALOI/KML - DSS BLOOD BANK PRE-EXTRACT AUDIT REPORT ; 8/1 3/07 7:08am2 ;;3.0;DSS EXTRACTS;**78,92 ,105**;Dec 22, 1997;Build 701 ECXPLBB ;DALOI/KML - DSS BLOOD BANK PRE-EXTRACT AUDIT REPORT ; 8/14/06 10:10am 2 ;;3.0;DSS EXTRACTS;**78,92**;Dec 22, 1997;Build 30 3 3 ;Per VHA Directive 97-033 this routine should not be modified. Medical Device # BK970021 4 4 ;entry point from option … … 39 39 HED ; 40 40 S ECPG=ECPG+1 41 W !,"LBB Extract Audit Report",?72,"Page",$J(ECPG,3)41 W !,"LBB Pre-Extract Audit Report",?72,"Page",$J(ECPG,3) 42 42 W !,ECSDN," - ",ECEDN,?58,"Run Date:",$J(ECRDT,12) 43 43 W !,?37,"Transf",?57,"Number" … … 50 50 I '$D(ECNODE) S ECNODE=7 51 51 I '$D(ECHEAD) S ECHEAD=" " 52 W @IOF,!,"LBB Extract Audit Report Information for DSS",!!52 W @IOF,!,"LBB Pre-Extract Audit Report Information for DSS",!! 53 53 S:'$D(ECINST) ECINST=+$P(^ECX(728,1,0),U) 54 54 S ECXINST=ECINST … … 78 78 F X="ECFILE","ECHEAD","ECVER","ECINST","ECXINST" S ZTSAVE(X)="" 79 79 F X="ECXLOGIC","ECXDATES" S ZTSAVE(X)="" 80 S ZTDESC=ECPACK_" EXTRACT AUDIT REPORT: "_ECSDN_" TO "_ECEDN,ZTRTN="START^ECXPLBB",ZTIO=""80 S ZTDESC=ECPACK_" PRE-EXTRACT AUDIT REPORT: "_ECSDN_" TO "_ECEDN,ZTRTN="START^ECXPLBB",ZTIO="" 81 81 S IOP="Q" W ! S %ZIS="QMP" D ^%ZIS S:POP ECXPOP=1 Q:POP I $D(IO("Q")) K IO("Q"),ZTIO D ^%ZTLOAD W:$D(ZTSK) !,$C(7),"REQUEST QUEUED",!,"Task #: ",$G(ZTSK) K I,ZTSK,ZTIO,ZTSAVE,ZTRTN D HOME^%ZIS S ECXPOP=1 82 82 Q -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECXPRO.m
r628 r636 1 ECXPRO ;ALB/GTS - Prosthetics Extract for DSS ; 1 0/17/07 3:47pm2 ;;3.0;DSS EXTRACTS;**9,13,15,21,24,33,39,46,71,92 ,105**;Dec 22, 1997;Build 701 ECXPRO ;ALB/GTS - Prosthetics Extract for DSS ; 11/2/06 8:56am 2 ;;3.0;DSS EXTRACTS;**9,13,15,21,24,33,39,46,71,92**;Dec 22, 1997;Build 30 3 3 BEG ;entry point from option 4 4 D SETUP I ECFILE="" Q … … 40 40 ..S ECXFORM=$G(ECXP(660,ECXDACT,11,"E"))_U_$G(ECXP(660,ECXDACT,11,"I")) 41 41 ..Q:'$$PATDEM^ECXUTL2(ECXDFN,ECXCT) 42 ..S OK=$$PAT^ECXUTL3(ECXDFN,ECXDATE,"1;5",.ECXPAT)43 ..I 'OK S ECXERR=1 K ECXPAT Q44 ..;OEF/OIF data45 ..S ECXOEF=ECXPAT("ECXOEF")46 ..S ECXOEFDT=ECXPAT("ECXOEFDT")47 42 ..Q:'$$NTEG^ECXPRO1(ECXDFN,.ECXLNE,ECXDACT,ECX0,ECXLB,ECINST,ECXFORM) 48 43 ..D PROSINFO^ECXPRO1(ECXDACT,ECXLB,ECX0,ECXFORM) 49 44 ..S CPTCODE=$E(ECXHCPCS,1,5) 50 ..;nppd entry date51 ..S ECXNPPDT=$$ECXDATE^ECXUTL($P(ECX0,U,1),ECXYM)52 45 ..; 53 46 ..;Get production division ;p-46 … … 97 90 ;icd9-4 (ECXICD94)^agent orange^radiation^env contam^eligibility^ 98 91 ;cost^lab labor cost^lab matl cost^billing status^ 99 ;vet^transact ion type^req station^rec station^file#661.1 ien92 ;vet^transacton type^req station^rec station^file#661.1 ien 100 93 ;node1 101 ;zip^dob^sex^amis grouper^p laceholder^mpi^dss dept ECXDSSD^94 ;zip^dob^sex^amis grouper^pc prov npi^mpi^dss dept ECXDSSD^ 102 95 ;pc prov person class^race^pow status^pow loc^ 103 96 ;sharing agree payor^sharing agree ins^mst status^ 104 97 ;enroll loc^state^county^assoc pc provider^ 105 ;assoc pc prov person class^ placeholder98 ;assoc pc prov person class^assoc pc prov npi 106 99 ;dom (ECXDOM)^purple heart indicator (ECXPHI)^ 107 100 ;enrollment Category (ECXCAT)^enrollment status (ECXSTAT)^ … … 116 109 ;emergency response indicator(FEMA) ECXERI^agent orange indicator ECXAO 117 110 ;^environ contam ECXECE^head/neck cancer ECXHNC^encntr mst ECXMIL^ 118 ;radiation ECXIR^OEF/OIF ECXOEF^OEF/OIF return date ECXOEFDT^ 119 ;nppd code ECXNPPDC^nppd entry date ECXNPPDT 120 ;assoc pc provider npi ECASNPI^primary care provider npi ECPTNPI 111 ;radiation ECXIR 121 112 N DA,DIK 122 113 S EC7=$O(^ECX(ECFILE,999999999),-1),EC7=EC7+1 … … 128 119 S ECODE=ECODE_ECXLMC_U_ECXBILST_U_ECXVET_U_ECXTYPE_U_ECXRQST_U_ECXRCST_U 129 120 S ECODE=ECODE_ECXPHCPC_U 130 S ECODE1=ECXZIP_U_ECXDOB_U_ECXSEX_U_ECXGRPR_U_ U_ECXMPI_U121 S ECODE1=ECXZIP_U_ECXDOB_U_ECXSEX_U_ECXGRPR_U_ECPTNPI_U_ECXMPI_U 131 122 S ECODE1=ECODE1_ECXDSSD_U_ECCLAS_U_ECXRACE_U_ECXPST_U_ECXPLOC_U 132 123 S ECODE1=ECODE1_U_U_ECXMST_U_ECXENRL_U_ECXSTATE_U 133 S ECODE1=ECODE1_ECXCNTY_U_ECASPR_U_ECCLAS2_U_ U_ECXDOM_U124 S ECODE1=ECODE1_ECXCNTY_U_ECASPR_U_ECCLAS2_U_ECASNPI_U_ECXDOM_U 134 125 S ECODE1=ECODE1_ECXCAT_U_ECXSTAT_U_$S(ECXLOGIC<2005:ECXPRIOR,1:"")_U_ECXPHI_U_ECXPOS_U 135 126 S ECODE1=ECODE1_ECXOBS_U_ECXENC_U_ECXAOL_U_ECXCNH_U_ECXPDIV_U 136 127 S ECODE1=ECODE1_ECXHNCI_U_ECXETH_U_ECXRC1_U 137 128 I ECXLOGIC>2004 S ECODE1=ECODE1_U_ECXPRIOR_ECXSBGRP_U_ECXUESTA_U_ECXPTYPE_U_ECXCVE_U_ECXCVEDT_U_ECXCVENC_U_ECXNPRFI 138 I ECXLOGIC>2006 S ECODE1=ECODE1_U_ECXERI_U_ECXAO_U_ECXECE_U_ECXHNC_U_ECXMIL_U_ECXIR_U 139 I ECXLOGIC>2007 S ECODE2=ECXOEF_U_ECXOEFDT_U_ECXNPPDC_U_ECXNPPDT_U_ECASNPI_U_ECPTNPI 140 S ^ECX(ECFILE,EC7,0)=ECODE,^ECX(ECFILE,EC7,1)=ECODE1,^ECX(ECFILE,EC7,2)=$G(ECODE2),ECRN=ECRN+1 129 I ECXLOGIC>2006 S ECODE1=ECODE1_U_ECXERI_U_ECXAO_U_ECXECE_U_ECXHNC_U_ECXMIL_U_ECXIR 130 S ^ECX(ECFILE,EC7,0)=ECODE,^ECX(ECFILE,EC7,1)=ECODE1,ECRN=ECRN+1 141 131 S DA=EC7,DIK="^ECX("_ECFILE_"," D IX1^DIK K DIK,DA 142 132 I $D(ZTQUEUED),$$S^%ZTLOAD S QFLG=1 -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECXPRO1.m
r628 r636 1 ECXPRO1 ;ALB/GTS - Prosthetics Extract for DSS (Continued) ; 11/8/07 8:02am2 ;;3.0;DSS EXTRACTS;**9,11,13,15,21,24,33,37,39,100 ,105**;Dec 22, 1997;Build 701 ECXPRO1 ;ALB/GTS - Prosthetics Extract for DSS (Continued) ; DEC 15, 2006 2 ;;3.0;DSS EXTRACTS;**9,11,13,15,21,24,33,37,39,100**;Dec 22, 1997;Build 2 3 3 ; 4 4 NTEG(ECXDFN,ECXLNE,ECXPIEN,ECXN0,ECXNLB,ECINST,ECXFORM) ;** Check for required fields … … 22 22 ; ECXRCST - Receiving Station 23 23 ; ECXPHCPC - PSAS HCPCS code; if 'unknown', then use CPT/HCPCS code 24 ; ECXNPPDC - NPPD code for repairs or new issues25 24 ; Output (KILLed by NTEG) 26 25 ; ECXMISS - 1 indicates missing information … … 28 27 ; 29 28 N ECXGOOD,ECXMISS 30 S (ECXRCST,ECXRQST ,ECXNPPDC)="",ECXGOOD=1,ECXSTAT2=$P(ECXN0,U,10)29 S (ECXRCST,ECXRQST)="",ECXGOOD=1,ECXSTAT2=$P(ECXN0,U,10) 31 30 I ECXSTAT2]"" D 32 31 .K ECXDIC … … 46 45 ;get psas hcpcs code from file #661.1 47 46 S ECXPHCPC=$P($G(^RMPR(660,ECXPIEN,1)),U,4) D 48 .;get nppd code for repairs and new issues 10 characters in length. 49 .I "X5"[ECXTYPE S ECXNPPDC=$TR($$GET1^DIQ(661.1,ECXPHCPC_",",5)," ","_") 50 .I "IR"[ECXTYPE S ECXNPPDC=$TR($$GET1^DIQ(661.1,ECXPHCPC_",",6)," ","_") 47 .;I +ECXPHCPC S ECXPHCPC=$P($G(^RMPR(661.1,ECXPHCPC,0)),U,1) 51 48 .I +ECXPHCPC S ECXPHCPC=$E($P($G(^RMPR(661.1,ECXPHCPC,0)),U,1),1,5) 52 49 .I ECXPHCPC="UNKNOWN" S ECXPHCPC=$E(ECXHCPCS,1,5) -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECXQSR.m
r628 r636 1 ECXQSR ;ALB/JAP,BIR/PTD-DSS QUASAR Extract ; 7/31/07 11:19pm2 ;;3.0;DSS EXTRACTS;**11,8,13,26,24,34,33,35,39,43,46,49,64,71,84,92,106 ,105**;Dec 22, 1997;Build 701 ECXQSR ;ALB/JAP,BIR/PTD-DSS QUASAR Extract ; 04/16/07 8:58am 2 ;;3.0;DSS EXTRACTS;**11,8,13,26,24,34,33,35,39,43,46,49,64,71,84,92,106**;Dec 22, 1997;Build 1 3 3 BEG ;entry point from option 4 4 I '$O(^ACK(509850.8,0)) W !,"You must be using the Quality Audiology & Speech Pathology",!,"Audit & Review (QUASAR) software to run this extract.",!! Q … … 35 35 S ECXDFN=$P(ECZNODE,U,2) 36 36 Q:'$$PATDEM^ECXUTL2(ECXDFN,ECD,"1;3;5") 37 S OK=$$PAT^ECXUTL3(ECXDFN,ECDT,"1;5",.ECXPAT)38 I 'OK S ECXERR=1 K ECXPAT Q39 ;OEF/OIF data40 S ECXOEF=ECXPAT("ECXOEF")41 S ECXOEFDT=ECXPAT("ECXOEFDT")42 ;43 37 S ECHL="",ECXDIV=$P($G(^ACK(509850.6,ECDA,5)),U),ECSTOP=$P(EC2NODE,U) 44 38 S ECXPDIV=$$GETDIV^ECXDEPT(ECXDIV) ; Get Production Division … … 63 57 I +ECXQV=2 D 64 58 .S ECXPRV1=$P(EC2NODE,U,7),ECXPRV2=$P(EC2NODE,U,3),ECXPRV3=$P(EC2NODE,U,5),ECPN=0 65 .S ECPR1NPI=$$NPI^XUSNPI("Individual_ID",ECXPRV1,ECD)66 .S:+ECPR1NPI'>0 ECPR1NPI="" S ECPR1NPI=$P(ECPR1NPI,U)67 .S ECPR2NPI=$$NPI^XUSNPI("Individual_ID",ECXPRV2,ECD)68 .S:+ECPR2NPI'>0 ECPR2NPI="" S ECPR2NPI=$P(ECPR2NPI,U)69 .S ECPR3NPI=$$NPI^XUSNPI("Individual_ID",ECXPRV3,ECD)70 .S:+ECPR3NPI'>0 ECPR3NPI="" S ECPR3NPI=$P(ECPR3NPI,U)71 59 .F S ECPN=$O(^ACK(509850.6,ECDA,3,ECPN)) Q:'ECPN D 72 60 ..S XX=^ACK(509850.6,ECDA,3,ECPN,0),XX=$P(XX,U),XX=$P($G(^ACK(509850.4,XX,0)),U),ECXCPT=$E($$CPT^ECXUTL3(XX),1,5) … … 140 128 .S:ECXPRV1'="" ECXPPC1=$$PRVCLASS^ECXUTL(ECXPRV1,ECD),ECXPRV1=2_ECXPRV1 141 129 .S ECP=$P(LOC(CPT),U,3) I ECP="" S ECP=$$CPT^ECXUTL3(CPT,"",ECV) 142 .D FILE ^ECXQSR1130 .D FILE 143 131 K CPT,LOC 132 Q 133 FILE ;file record in #727.825 134 ;node0 135 ;inst^dfn ECXDFN^ssn ECXSSN^name ECXPNM^i/o status ECXA^day ECDAY^ 136 ;DSS unit ECDU^^category ECPTTM^procedure ECP^volume ECV^cost center^ 137 ;ordering sec ^section^provider ECXPRV1^ECXPPC1^ECXPRV2^ECXPPC2^ECXPRV3^ 138 ;ECXPPC3^mov # ECXMN^treat spec ECXTS^time ECTIME^primary care team 139 ;ECPTTM^primary care provider ECPTPR^pce cpt code & modifers ECXCPT^ 140 ;primary icd-9 code ECDIA^secondary icd-9 #1 ECXICD91^secondary icd-9 141 ;#2 ECXICD92^secondary icd-9 #3 ECXICD93^secondary icd-9 #4 ECXICD94^ 142 ;agent orange ECXAST^radiation exposure ECRST^environmental 143 ;contaminants ECEST^service connected ECSC^sent to pce^^dss identifier 144 ;ECDSS^placeholder 145 ;node1 146 ;mpi ECXNPI^dss dept ECXDSSD^provider npi ECUN1NPI^^^pc prov person 147 ;class ECPTNPI^assoc pc provider ECASPR^assoc pc prov person class 148 ;ECCLAS2^assoc pc provider npi ECASNPI^divison ECXDIV^dom ECXDOM^ 149 ;enrollment category ECXCAT^enrollment status ECXSTAT^enrollment prior 150 ;ECXPRIOR^period of service ECXPOS^purple heart ECXPHI^observ pat ind 151 ;ECXOBS^encounter num ECXENC^ao loc ECXAOL^ord div ECXODIV^contr st dt 152 ;ECXCSDT^contr end dt ECXCEDT^contr typ ECXCTYP^CNH stat ECXCNH^ 153 ;production division ECXPDIV^eligibility ECXELIG^ethnicity ECXETH^ 154 ;race1 ECXRC1^enrollment location ECXENRL^^enrollment priority 155 ;ECXPRIOR_enrollment subgroup ECXSBGRP^user enrollee ECXUESTA^patient 156 ;type ECXPTYPE^combat vet elig ECXCVE^combat vet elig end date ECXCVEDT^ 157 ;enc cv eligible ECXCVENC^national patient record flag ECXNPRFI^ 158 ;emergency response indicator(FEMA) ECXERI^agent orange indicator 159 ;ECXAO^environ contam ECXECE^head/neck ECXHNC^military sexual trauma 160 ;ECXMIL^radiation encoun ECXIR^nutrition dx 161 N DA,DIK 162 S EC7=$O(^ECX(ECFILE,999999999),-1),EC7=EC7+1 163 S ECODE=EC7_U_EC23_U 164 S ECODE=ECODE_ECL_U_ECXDFN_U_ECXSSN_U_ECXPNM_U_ECXA_U_ECDAY_U_ECDU_U_U 165 S ECODE=ECODE_ECP_U_ECV_U_ECCS_U_ECO_U_ECM_U_ECXPRV1_U_ECXPPC1_U 166 S ECODE=ECODE_ECXPRV2_U_ECXPPC2_U_ECXPRV3_U_ECXPPC3_U_U 167 S ECODE=ECODE_ECXMN_U_ECXTS_U_ECTIME_U_ECPTTM_U 168 S ECODE=ECODE_ECPTPR_U_ECXCPT_U_ECDIA_U_ECXICD91_U_ECXICD92_U 169 S ECODE=ECODE_ECXICD93_U_ECXICD94_U_ECXAST_U_ECXRST_U_ECXEST_U 170 S ECODE=ECODE_ECSC_U_"N"_U_U_ECDSS_U_U 171 S ECODE1=ECXMPI_U_ECXDSSD_U_ECUN1NPI_U_U_U_ECCLAS_U_ECPTNPI_U_ECASPR_U 172 S ECODE1=ECODE1_ECCLAS2_U_ECASNPI_U_ECXDIV_U_ECXMST_U_ECXDOM_U 173 S ECODE1=ECODE1_ECXDOB_U_ECXCAT_U_ECXSTAT_U_$S(ECXLOGIC<2005:ECXPRIOR,1:"")_U_ECXPOS_U_ECXPHI_U 174 S ECODE1=ECODE1_ECXOBS_U_ECXENC_U_ECXAOL_U_ECXODIV_U_ECXCSDT_U_ECXCEDT_U 175 S ECODE1=ECODE1_ECXCTYP_U_ECXCNH_U_ECXPDIV_U_ECXELIG_U_ECXHNCI_U_ECXETH_U 176 S ECODE1=ECODE1_ECXRC1 177 I ECXLOGIC>2003 S ECODE1=ECODE1_U_ECXENRL 178 I ECXLOGIC>2004 S ECODE1=ECODE1_U_U_ECXPRIOR_ECXSBGRP_U_ECXUESTA_U_ECXPTYPE_U_ECXCVE_U 179 I ECXLOGIC>2004 S ECODE2=ECXCVEDT_U_ECXCVENC_U_ECXNPRFI 180 I ECXLOGIC>2006 S ECODE2=ECODE2_U_ECXERI_U_ECXAO_U_ECXECE_U_ECXHNC_U_ECXMIL_U_ECXIR_U 181 S ^ECX(ECFILE,EC7,0)=ECODE,^ECX(ECFILE,EC7,1)=ECODE1,^ECX(ECFILE,EC7,2)=$G(ECODE2),ECRN=ECRN+1 182 S DA=EC7,DIK="^ECX("_ECFILE_"," D IX1^DIK K DIK,DA 183 I $D(ZTQUEUED),$$S^%ZTLOAD 144 184 Q 145 185 SETUP ;Set required input for ECXTRAC -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECXRAD.m
r628 r636 1 ECXRAD ;ALB/JAP,BIR/PDW,PTD-Extract for Radiology ; 5/30/20072 ;;3.0;DSS EXTRACTS;**11,8,13,16,24,33,39,46,71,84,92 ,105**;Dec 22, 1997;Build 701 ECXRAD ;ALB/JAP,BIR/PDW,PTD-Extract for Radiology ; 6/23/06 6:52am 2 ;;3.0;DSS EXTRACTS;**11,8,13,16,24,33,39,46,71,84,92**;Dec 22, 1997;Build 30 3 3 BEG ;entry point from option 4 4 D SETUP I ECFILE="" Q … … 17 17 ; 18 18 GET ;get data 19 N ECXIEN,X,SUB,TYPE,ECDOCPC,ECXIS,ECXISPC,ECXPRCL,ECXCSC ,ECXUSRTN19 N ECXIEN,X,SUB,TYPE,ECDOCPC,ECXIS,ECXISPC,ECXPRCL,ECXCSC 20 20 S ^TMP("ECL",$J,ECXDFN)="" 21 21 ;with dfn get all exams within date range … … 60 60 ...S ECXW=$P(ECCA,U,6),ECXW=$P($G(^DIC(42,+ECXW,44)),U) 61 61 ...S:ECXW="" ECXW=$P(ECCA,U,8) 62 ...S ECDOCNPI=$$NPI^XUSNPI("Individual_ID",$P(ECCA,U,14),ECDT)63 ...S:+ECDOCNPI'>0 ECDOCNPI="" S ECDOCNPI=$P(ECDOCNPI,U)64 62 ...S (ECXDSSD,ECXDSSP)="" 65 ...S ECS=$P(ECCA,U,7),ECDOC=ECPROF_$P(ECCA,U,14),ECD I=$P(ECCA,U,13),ECDOCPC=$$PRVCLASS^ECXUTL($P(ECCA,U,14),ECDT)63 ...S ECS=$P(ECCA,U,7),ECDOC=ECPROF_$P(ECCA,U,14),ECDOCNPI="",ECDI=$P(ECCA,U,13),ECDOCPC=$$PRVCLASS^ECXUTL($P(ECCA,U,14),ECDT) 66 64 ...S ECPRO=$P(ECCA,U,2),ECSTAT=$P($G(^RA(72,+$P(ECCA,U,3),0)),U,3) 67 65 ...;get the primary interpreting staff and the person class DBIA #65 68 66 ...S ECXIS=$P(ECCA,U,15),ECXISPC=$$PRVCLASS^ECXUTL(ECXIS,ECDT) 69 ...S ECISNPI=$$NPI^XUSNPI("Individual_ID",ECXIS,ECDT)70 ...S:+ECISNPI'>0 ECISNPI="" S ECISNPI=$P(ECISNPI,U)71 67 ...;prefix interpreting radiologist with a "2" if not null 72 68 ...S ECXIS=$S(ECXIS:"2"_ECXIS,1:"") … … 104 100 ;imaging type^primary care team^primary care provider 105 101 ;node1 106 ;mpi^dss dept^ placeholder^placeholder^pc prov person class^107 ;assoc pc provider^assoc pc prov person class^ placeholder^dom^102 ;mpi^dss dept^req physician npi^pc provider npi^pc prov person class^ 103 ;assoc pc provider^assoc pc prov person class^assoc pc prov npi^dom^ 108 104 ;observ pat ind^encounter num^ord stop code^ord date^division^ 109 105 ;dss product ECXDSSP^requesting provider person class ECDOCPC^interp- 110 106 ;reting radiologist ECXIS^interpreting radiologist pc ECXISPC^princi- 111 107 ;pal clinic ECXPRCL^clinc stop code ECXCSC^emergency response indicator 112 ;(FEMA) ECXERI ^assoc pc provider npi^interpreting rad npi^pc provider npi^req physician npi108 ;(FEMA) ECXERI 113 109 N DA,DIK 114 110 S EC7=$O(^ECX(ECFILE,999999999),-1),EC7=EC7+1 … … 117 113 S ECODE=ECODE_ECDOC_U_ECMODS_U_ECXMN_U_ECXTS_U_ECTM_U_ECTY_U_ECPTTM_U 118 114 S ECODE=ECODE_ECPTPR_U 119 S ECODE1=ECXMPI_U_ECXDSSD_U_ U_U_ECCLAS_U_ECASPR_U120 S ECODE1=ECODE1_ECCLAS2_U_ U_ECXDOM_U_ECXOBS_U_ECXENC_U_ECXORDST_U115 S ECODE1=ECXMPI_U_ECXDSSD_U_ECDOCNPI_U_ECPTNPI_U_ECCLAS_U_ECASPR_U 116 S ECODE1=ECODE1_ECCLAS2_U_ECASNPI_U_ECXDOM_U_ECXOBS_U_ECXENC_U_ECXORDST_U 121 117 S ECODE1=ECODE1_ECXORDDT_U_ECXPDIV_U 122 118 I ECXLOGIC>2004 S ECODE1=ECODE1_ECXDSSP_U_ECDOCPC 123 119 I ECXLOGIC>2005 S ECODE1=ECODE1_U_ECXIS_U_ECXISPC_U_ECXPRCL_U_ECXCSC 124 120 I ECXLOGIC>2006 S ECODE1=ECODE1_U_ECXERI 125 I ECXLOGIC>2007 S ECODE1=ECODE1_U_ECASNPI_U_ECISNPI_U_ECPTNPI_U_ECDOCNPI126 121 S ^ECX(ECFILE,EC7,0)=ECODE,^ECX(ECFILE,EC7,1)=ECODE1,ECRN=ECRN+1 127 122 S DA=EC7,DIK="^ECX("_ECFILE_"," D IX1^DIK K DIK,DA -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECXSCLD.m
r628 r636 1 ECXSCLD ;BIR/DMA,CML-Enter, Print and Edit Entries in 728.44 ; 5/24/07 3:49pm2 ;;3.0;DSS EXTRACTS;**2,8,24,30,71,80 ,105**;Dec 22, 1997;Build 701 ECXSCLD ;BIR/DMA,CML-Enter, Print and Edit Entries in 728.44 ; 9/21/04 7:33am 2 ;;3.0;DSS EXTRACTS;**2,8,24,30,71,80**;Dec 22, 1997 3 3 EN ;entry point from option 4 4 ;load entries … … 60 60 E W !,"(NEVER REVIEWED)" 61 61 W ! 62 W !!,?1,"CLINIC",? 31,"STOP",?38,"CREDIT",?47,"DSS",?54,"DSS",?63,"ACTION",?71,"NAT'L"63 W !,? 31,"CODE",?38,"STOP",?47,"STOP",?54,"CREDIT",?71,"CODE",!,?1,"(* - currently inactive)",?38,"CODE",?47,"CODE",?54,"CODE",!,LN Q62 W !!,?1,"CLINIC",?27,"STOP",?34,"CREDIT",?43,"DSS",?50,"DSS",?59,"ACTION",?67,"NAT'L",?74,"DSS" 63 W !,?27,"CODE",?34,"STOP",?43,"STOP",?50,"CREDIT",?67,"CODE",?74,"DEPT",!,?1,"(* - currently inactive)",?34,"CODE",?43,"CODE",?50,"CODE",!,LN Q 64 64 ; 65 65 SHOWEM ; list clinics for worksheet 66 66 I $Y+4>IOSL D HEAD Q:QFLG 67 W !!,$E(ECSC,1, 31) W:$P(ECD,U,9)]"" "*" F J=1:1:5 W ?$P("31,38,47,54,66",",",J),$S($P(ECD,U,J):$P(ECD,U,J),J<3:"",1:"_____")68 S ECN=$P($G(^ECX(728.441,+$P(ECD,U,7),0)),U) W ? 71,$S(ECN]"":ECN,1:"____")67 W !!,$E(ECSC,1,25) W:$P(ECD,U,9)]"" "*" F J=1:1:5 W ?$P("27,34,43,50,62",",",J),$S($P(ECD,U,J):$P(ECD,U,J),J<3:"",1:"_____") 68 S ECN=$P($G(^ECX(728.441,+$P(ECD,U,7),0)),U) W ?67,$S(ECN]"":ECN,1:"____"),?74,$S($P(ECD,U,10)'="":$P(ECD,U,10),1:"___") 69 69 Q 70 70 SS ;SCROLL STOPS -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECXSCX1.m
r628 r636 1 ECXSCX1 ;ALB/JAP,BIR/DMA-Clinic Extract Message ; 4/11/07 3:26pm2 ;;3.0;DSS EXTRACTS;**8,28,24,27,29,30,31,33,84,92 ,105**;Dec 22, 1997;Build 701 ECXSCX1 ;ALB/JAP,BIR/DMA-Clinic Extract Message ; 8/17/06 7:59am 2 ;;3.0;DSS EXTRACTS;**8,28,24,27,29,30,31,33,84,92**;Dec 22, 1997;Build 30 3 3 EN ;entry point from ecxscx 4 4 N ECX … … 148 148 .I '$D(ARY("P",ICD("S",I))) D 149 149 ..S CNT=CNT+1,ECXVIST("ICD9"_CNT)=$P($G(^ICD9(ICD("S",I),0)),U) 150 S:(ECXVIST("ICD9P")="")&(ECXVIST("ICD91")="") ECXVIST("ICD9P")="799.9" 150 151 ;get first provider designated as primary 151 152 ;if no primary, then get first physician provider -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECXSCX2.m
r628 r636 1 ECXSCX2 ;ALB/ESD DSS Clinic Extract Utilities (continued) ; 6/5/20072 ;;3.0;DSS EXTRACTS;**39,46,49,71,84,92 ,105**;Dec 22, 1997;Build 701 ECXSCX2 ;ALB/ESD DSS Clinic Extract Utilities (continued) ; 11/2/06 8:59am 2 ;;3.0;DSS EXTRACTS;**39,46,49,71,84,92**;Dec 22, 1997;Build 30 3 3 ; 4 4 ; … … 27 27 ;- Agent Orange location 28 28 S ECXAOL=ECXPAT("AOL") 29 ;OEF/OIF data30 S ECXOEF=ECXPAT("ECXOEF")31 S ECXOEFDT=ECXPAT("ECXOEFDT")32 29 I $$ENROLLM^ECXUTL2(ECXDFN) 33 30 ; - Head and Neck Cancer Indicator -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECXSCXN.m
r628 r636 1 ECXSCXN ;ALB/JAP Clinic Extract ; 6/5/07 11:55am2 ;;3.0;DSS EXTRACTS;**24,27,29,30,31,32,33,39,46,49,52,71,84,92,107 ,105**;Dec 22, 1997;Build 701 ECXSCXN ;ALB/JAP Clinic Extract ; 4/19/2007 2 ;;3.0;DSS EXTRACTS;**24,27,29,30,31,32,33,39,46,49,52,71,84,92,107**;Dec 22, 1997;Build 9 3 3 ; 4 4 BEG ;entry point from option … … 77 77 ..S SOURCE=ECXVIST("SOURCE"),ECXAO=ECXVIST("AO"),ECXIR=ECXVIST("IR") 78 78 ..S ECXMIL=ECXVIST("MST"),ECXPROV=ECXVIST("PROV") 79 ..S ECPRNPI=$$NPI^XUSNPI("Individual_ID",ECXPROV,ECXDATE)80 ..S:+ECPRNPI'>0 ECPRNPI="" S ECPRNPI=$P(ECPRNPI,U)81 79 ..S ECXPROVP=ECXVIST("PROV CLASS"),ECXPROVN=ECXVIST("PROV NPI") 82 80 ..S ECXECE=ECXVIST("PGE"),ECXHNC=ECXVIST("HNC") … … 140 138 S STR(1)=STR(1)_ECXRACE_U_ECXPST_U_ECXPLOC_U_ECXRST_U_ECXIR_U_ECXAST_U 141 139 S STR(1)=STR(1)_ECXAO_U_ECXMPI_U_ECXDSSD_U_ECXSEX_U_ECXZIP_U 142 S STR(1)=STR(1)_$G(ECXPCPNP)_U_ U_ECXENEL_U_ECXMST_U140 S STR(1)=STR(1)_$G(ECXPCPNP)_U_$G(ECXNPIPR)_U_ECXENEL_U_ECXMST_U 143 141 S STR(1)=STR(1)_ECXMIL_U_U_U_ECXENRL_U_ECXSTATE_U 144 S STR(1)=STR(1)_ECXCNTY_U_ECASPR_U_ECCLAS2_U_ U_ECXDOM_U_ECXCAT_U142 S STR(1)=STR(1)_ECXCNTY_U_ECASPR_U_ECCLAS2_U_ECASNPI_U_ECXDOM_U_ECXCAT_U 145 143 S STR(2)=ECXSTAT_U_$S(ECXLOGIC<2005:ECXPRIOR,1:"")_U_ECXPHI_U_ECXPOS_U_ECXOBS_U_ECXENC_U 146 144 S STR(2)=STR(2)_ECXAOL_U_ECXPDIV_U_ECXATYP_U_ECXPVST_U_ECXMTST_U … … 150 148 I ECXLOGIC>2005 S STR(2)=STR(2)_U_ECXEST_U_ECXECE 151 149 I ECXLOGIC>2006 S STR(2)=STR(2)_U_ECXERI_U_ECXHNC 152 I ECXLOGIC>2007 S STR(2)=STR(2)_U_ECXOEF_U_ECXOEFDT_U_ECASNPI_U_ECPTNPI_U_$G(ECPRNPI)153 150 D FILE2^ECXSCX2(727.827,EC7,.STR) 154 151 S ECRN=ECRN+1,$P(^ECX(727.827,0),U,3)=EC7 -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECXSCXN1.m
r628 r636 1 ECXSCXN1 ;ALB/JAP Clinic Extract No Shows; 8/28/02 1:11pm ; 9/6/07 3:17pm2 ;;3.0;DSS EXTRACTS;**71 ,105**;Dec 22, 1997;Build 701 ECXSCXN1 ;ALB/JAP Clinic Extract No Shows; 8/28/02 1:11pm ; 10/26/04 10:35am 2 ;;3.0;DSS EXTRACTS;**71**;Dec 22, 1997 3 3 NOSHOW(ECXSD,ECXED) ;get noshows from file #44 4 4 ; ECXSD = start date, ECXED = end date … … 31 31 ....S ECXPVST=$P(NODE,U,7),ECXATYP=$P(NODE,U,16) ;Get POV & appt type 32 32 ....S:+ALEN=0 ALEN=$P($G(^TMP($J,"ECXCL",CLIN)),U,2) 33 ....S ECXCLIN=CLIN,ECXSTOP=P1 33 ....S ECXCLIN=CLIN,ECXSTOP=P1 S:ECXICD9P="" ECXICD9P="799.9" 34 34 ....S:ECXCPT1="" ECXCPT1="9919901" 35 35 ....S ECXCBOC=$S(MDIV'="":$$CBOC^ECXSCX2(.MDIV),1:"") -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECXSURG.m
r628 r636 1 ECXSURG ;ALB/JA,BIR/DMA,PTD-Surgery Extract for DSS ; 11/2 0/07 8:13am2 ;;3.0;DSS EXTRACTS;**1,11,8,13,25,24,33,39,41,42,46,50,71,84,92,99 ,105**;Dec 22, 1997;Build 701 ECXSURG ;ALB/JA,BIR/DMA,PTD-Surgery Extract for DSS ; 11/2/06 9:00am 2 ;;3.0;DSS EXTRACTS;**1,11,8,13,25,24,33,39,41,42,46,50,71,84,92,99**;Dec 22, 1997;Build 2 3 3 BEG ;entry point from option 4 4 D SETUP I ECFILE="" Q … … 16 16 N J,X,Y,PP,DATA1,DATA2,DATAOP,ARR,ERR,SUB,MOD,ECXNONL,ECXSTOP,TIMEDIF 17 17 N ECPRO,ECXORCT,ECXPTHA,ECXNPRFI,ECXPA,ECXPAPC,ECSRPC,ECATPC,ECSAPC 18 N ECXCRST,ECXSTCD,ECXCLIN19 18 S ECXDATE=ECD,ECXERR=0,ECXQ="" 20 19 Q:'$$PATDEM^ECXUTL2(ECXDFN,ECXDATE,"1;2;3;5;") 21 20 I ECXADMDT="" S ECXADD=ECXADMDT 22 21 I ECXADMDT'="" S ECXADD=$$ECXDATE^ECXUTL(ECXADMDT,ECXYM) 23 S OK=$$PAT^ECXUTL3(ECXDFN,ECXDATE,"1;5",.ECXPAT)24 I 'OK S ECXERR=1 K ECXPAT Q25 ;OEF/OIF DATA26 S ECXOEF=ECXPAT("ECXOEF")27 S ECXOEFDT=ECXPAT("ECXOEFDT")28 22 S EC0=^SRF(ECD0,0) 29 23 S DATA1=$S($D(^SRF(ECD0,.1)):^(.1),1:"") 30 24 S DATA2=$S($D(^SRF(ECD0,.2)):^(.2),1:"") 25 ;S DATAOP=$S($D(^SRF(ECD0,"OP")):^("OP"),1:"") 31 26 S DATAOP=$S($D(^SRO(136,ECD0,0)):^(0),1:"") 32 27 S ECNO=$G(^SRF(ECD0,"NON")) 33 28 ;get data 34 29 S ECSR=$P(DATA1,U,4),(ECATNPI,ECSANPI,ECSRNPI)="",ECAT=$P(DATA1,U,13) 35 S ECSRNPI=$$NPI^XUSNPI("Individual_ID",ECSR,ECXDATE)36 S:+ECSRNPI'>0 ECSRNPI="" S ECSRNPI=$P(ECSRNPI,U)37 30 ;-Time patient in OR room (Nurse Time) 38 31 S ECXTM=$$ECXTIME^ECXUTL($P(DATA2,U,10)) … … 40 33 N ECXPDIV S ECXPDIV=$$RADDIV^ECXDEPT(ECXDIV) ;Production Division 41 34 S ECSA=$P($G(^SRF(ECD0,.3)),U,4),ECO=$P(EC0,U,2) 42 S ECSANPI=$$NPI^XUSNPI("Individual_ID",ECSA,ECXDATE)43 S:+ECSANPI'>0 ECSANPI="" S ECSANPI=$P(ECSANPI,U)44 35 ;get principle anesthetist and person class DBIA #103 45 36 S ECXPA=$P($G(^SRF(ECD0,.3)),U,1) 46 S ECPANPI=$$NPI^XUSNPI("Individual_ID",ECXPA,ECXDATE)47 S:+ECPANPI'>0 ECPANPI="" S ECPANPI=$P(ECPANPI,U)48 37 S ECXPAPC=$$PRVCLASS^ECXUTL(ECXPA,ECXDATE) 49 38 S ECORTY=$P($G(^SRS(+ECO,2)),U),ECO=$P($G(^SRS(+ECO,0)),U) … … 61 50 I $P(ECNO,U)="Y" D 62 51 .S ECSR=$P(ECNO,U,6),ECAT=$P(ECNO,U,7) 63 .S ECSRNPI=$$NPI^XUSNPI("Individual_ID",ECSR,ECXDATE)64 .S:+ECSRNPI'>0 ECSRNPI="" S ECSRNPI=$P(ECSRNPI,U)65 .S ECATNPI=$$NPI^XUSNPI("Individual_ID",ECAT,ECXDATE)66 .S:+ECATNPI'>0 ECATNPI="" S ECATNPI=$P(ECATNPI,U)67 52 .S ECXTM=$$ECXTIME^ECXUTL($P(ECNO,U,4)) 68 53 .S A1=$P(ECNO,U,5),A2=$P(ECNO,U,4),TIME="##" D:(A1&A2) TIME S ECNT=TIME … … 72 57 .;- Get DSS Stop Code to use in encounter number 73 58 .S ECXSTOP=$P($G(^ECX(728.44,ECXNONL,0)),U,4) 74 ;75 ;- Get credit stop, stop code and clinic76 I $$SUR^ECXUTL6(.ECXCRST,.ECXSTCD,.ECXCLIN)77 59 ; 78 60 ;- If surgery cancelled/aborted quit and go to next record … … 154 136 S ECXENC=$$ENCNUM^ECXUTL4(ECXA,ECXSSN,ECXADMDT,ECXDATE,ECXTS,ECXOBS,ECHEAD,ECXSTOP,ECSS) Q:ECXENC="" 155 137 ; 156 ;- Get postop diagnosis codes 157 I $$SURPODX^ECXUTL6(.ECXPODX,.ECXPODX1,.ECXPODX2,.ECXPODX3,.ECXPODX4,.ECXPODX5) 158 ; 159 D FILE^ECXSURG1 138 D FILE 160 139 ;get secondary procedures 161 140 ;ecode0=s^cpt code 162 141 S ECXJ=0 142 ;F S ECXJ=$O(^SRF(ECD0,13,ECXJ)) Q:'ECXJ I $D(^(ECXJ,0)),$D(^(2)),$P(^(2),U)]"" D 163 143 F S ECXJ=$O(^SRO(136,ECD0,3,ECXJ)) Q:'ECXJ I $D(^(ECXJ,0)),$D(^(0)),$P(^(0),"^")]"" D 164 144 .;S ECPT=$P(^SRF(ECD0,13,ECXJ,2),U),ECXCMOD="" 165 .S ECPT=$P(^SRO(136,ECD0,3,ECXJ,0),U),ECXMOD="" 166 .S ECPT=$P(^(0),"^"),ECXCMOD="" 145 . S ECPT=$P(^SRO(136,ECD0,3,ECXJ,0),"^"),ECXCMOD="" 167 146 .K ARR,ERR 168 147 .D FIELD^DID(130.16,4,,"LABEL","ARR","ERR") I $D(ARR("LABEL")) D … … 174 153 .S ECXCPT=$$CPT^ECXUTL3(ECPT,ECXCMOD) 175 154 .S ECODE0="S"_U ;_ECPT 176 .D FILE ^ECXSURG1155 .D FILE 177 156 ;get prostheses 178 157 ;ecode0=i^^^^^^prosthesis^old qty field (null) … … 181 160 .S ECXP=+^SRF(ECD0,1,ECXJ,0),ECXQ=$P($G(^(1)),U,2) S:'ECXQ ECXQ=1 182 161 .S ECODE0="I"_U_U_U_U_U_U_ECXP_U_U 183 .D FILE^ECXSURG1 184 Q 185 ; 162 .D FILE 163 Q 164 ; 165 FILE ;file record 166 ;node0 167 ;division^dfn^ssn^name^in/out (ECXA)^day^case #^ 168 ;surg specialty^or room #^ 169 ;surgeon^attending^anesthesia supervisor^anesthesia technique^ 170 ;primary/secondary/prostheses^cpt^^pt time^op time^anes time^ 171 ;prostheses^qty^^ 172 ;movement number^treating specialty^cancel/abort (ECCAN)^time^or type^ 173 ;attending's service^non-or dss id^recovery room time^^ 174 ;primary care team^primary care provider^admission date 175 ;node1 176 ;mpi^dss dept ECXDSSD^surgeon npi^attending npi^anes supervisor npi^ 177 ;pc provider npi^pc prov person class^ 178 ;assoc pc provider^assoc pc prov person class^assoc pc prov npi^ 179 ;cpt&modifiers ECXCPT^dom ECXDOM^enrollment category ECXCAT^ 180 ;enrollment status ECXSTAT^enrollment priority ECXPRIOR^ 181 ;period of service ECXPOS^purple heart indicator ECXPHI^ 182 ;observ pat ind ECXOBS^encounter num ECXENC^ao loc ECXAOL^ 183 ;production division ECXPDIV^head & neck canc ind ECXHNCI^ 184 ;ethnicity ECXETH^race1 ECXRC1^new quantity ECXQ^ 185 ;^user enrollee ECXUESTA^patient type ECXPTYPE^combat vet elig 186 ;ECXCVE^combat vet elig end date ECXCVEDT^enc cv eligible ECXCVENC 187 ;or clean time ECXORCT^time pt in hold area ECXPTHA^national patient 188 ;record flag ECXNPRFI^princ anesthetist ECXPA^surgeon per class ECSRPC 189 ;node2 190 ;atten surgeon per class ECATPC^anesthesia super person class ECSAPC^ 191 ;princ anesthetist PC ECXPAPC^emergency response indicator(FEMA) ECXERI^ 192 ;agent orange indic ECXAO^head/neck cancer ECXHNC 193 ; 194 N DA,DIK,STR 195 S EC7=$O(^ECX(ECFILE,999999999),-1),EC7=EC7+1 196 S ECODE=EC7_U_EC23_U_ECXDIV_U_ECXDFN_U_ECXSSN_U_ECXPNM_U_ECXA_U 197 S ECODE=ECODE_$$ECXDATE^ECXUTL(ECXDATE,ECXYM)_U_ECD0_U_ECSS_U_ECO_U 198 S ECODE=ECODE_ECSR_U_ECAT_U_ECSA_U_ECANE_U_ECODE0_U 199 S STR=ECXMN_U_ECXTS_U_$S(ECCAN'="":ECCAN,1:"")_U_ECXTM_U_ECORTY_U 200 S STR=STR_ECATSV_U_ECNL_U_ECRR_U_U_ECPTTM_U_ECPTPR_U_ECXADD_U 201 S $P(ECODE,U,26,38)=STR 202 S ECODE1=ECXMPI_U_ECXDSSD_U_ECSRNPI_U_ECATNPI_U_ECSANPI_U_ECPTNPI_U 203 S ECODE1=ECODE1_ECCLAS_U_ECASPR_U_ECCLAS2_U_ECASNPI_U_ECXCPT_U_ECXDOM_U 204 S ECODE1=ECODE1_ECXCAT_U_ECXSTAT_U_$S(ECXLOGIC<2005:ECXPRIOR,1:"")_U_ECXPOS_U_ECXPHI_U 205 S ECODE1=ECODE1_ECXOBS_U_ECXENC_U_ECXAOL_U_ECXPDIV_U_ECXHNCI_U 206 S ECODE1=ECODE1_ECXETH_U_ECXRC1_U_ECXQ_U 207 I ECXLOGIC>2004 S ECODE1=ECODE1_U_ECXPRIOR_ECXSBGRP_U_ECXUESTA_U_ECXPTYPE_U_ECXCVE_U_ECXCVEDT_U_ECXCVENC_U_ECXORCT_U_ECXPTHA_U_ECXNPRFI 208 I ECXLOGIC>2005 S ECODE1=ECODE1_U_ECXPA_U_ECSRPC_U,ECODE2=ECATPC_U_ECSAPC_U_ECXPAPC 209 I ECXLOGIC>2006 S ECODE2=ECODE2_U_ECXERI_U_ECXAO_U_ECXHNC 210 S ^ECX(ECFILE,EC7,0)=ECODE,^ECX(ECFILE,EC7,1)=ECODE1,^ECX(ECFILE,EC7,2)=ECODE2,ECRN=ECRN+1 211 S DA=EC7,DIK="^ECX("_ECFILE_"," D IX1^DIK K DIK,DA 212 I $D(ZTQUEUED),$$S^%ZTLOAD S QFLG=1 186 213 ; 187 214 TIME ; given date/time get increment -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECXTRAC.m
r628 r636 1 ECXTRAC ;ALB/GTS,JAP,BIR/DMA,CML-Package Extracts for DSS ; 7/29/07 12:51pm2 ;;3.0;DSS EXTRACTS;**9,8,14,24,30,33,49,84 ,105**;Dec 22, 1997;Build 701 ECXTRAC ;ALB/GTS,JAP,BIR/DMA,CML-Package Extracts for DSS ; 5/9/05 10:39am 2 ;;3.0;DSS EXTRACTS;**9,8,14,24,30,33,49,84**;Dec 22, 1997 3 3 ;Date range, queuing and message sending for package extracts 4 4 ;Input … … 184 184 CHK2 ;iv extract check - all active iv rooms to have a division 185 185 S EC=0 186 D ALL^PSJ59P5(,"??","ECXIV") 187 F S EC=$O(^TMP($J,"ECXIV",EC)) Q:'EC I '^(EC,19) D I CHKFLG D EXIT Q 188 .S CHKFLG=$S($G(^TMP($J,"ECXIV",EC,19)):1,$G(^(19))>DT:1,1:0) 186 F S EC=$O(^PS(59.5,EC)) Q:'EC I '$P(^PS(59.5,EC,0),U,4) D Q:CHKFLG 187 .S CHKFLG=$S('$G(^PS(59.5,EC,"I")):1,$G(^PS(59.5,EC,"I"))>DT:1,1:0) 189 188 .I CHKFLG D 190 189 ..W !!,"All active IV Rooms in the IV Room file (#59.5) must have a ""DIVISION""",!,"assigned to run this extract!" 191 190 ..W !!,"This information can be entered using the DSS Extract Manager's Maintenance ",!,"option ""Enter/Edit IV Room Division""." 192 191 ..D PAUSE 193 EXIT K ^TMP($J,"ECXIV")194 192 Q 195 193 ; -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECXTREX.m
r628 r636 1 ECXTREX ;BPFO/JRP - Queue DSS Fiscal Year Specific Extract;8-AUG-2003 ; 6/11/07 12:46pm2 ;;3.0;DSS EXTRACTS;**49,71,84,92 ,105**;Dec 22, 1997;Build 701 ECXTREX ;BPFO/JRP - Queue DSS Fiscal Year Specific Extract;8-AUG-2003 ; 11/2/06 9:02am 2 ;;3.0;DSS EXTRACTS;**49,71,84,92**;Dec 22, 1997;Build 30 3 3 ; 4 4 EN ;Main entry point … … 71 71 S DIR("A")="Select fiscal year logic to use for extract" 72 72 S DIR(0)="SO^" 73 F X=2003,2004,2005,2006,2007 ,2008D73 F X=2003,2004,2005,2006,2007 D 74 74 .S Y=$E(X,5) 75 75 .S Y=$S((Y="")!(Y=" "):"",1:"Revision "_Y_" of ") -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECXTRT.m
r628 r636 1 ECXTRT ;ALB/JAP,BIR/DMA,CML,PTD-Treating Specialty Change Extract ; 10/17/07 3:48pm2 ;;3.0;DSS EXTRACTS;**1,8,17,24,33,35,39,46,49,84,107 ,105**;Dec 22, 1997;Build 701 ECXTRT ;ALB/JAP,BIR/DMA,CML,PTD-Treating Specialty Change Extract ; 04/12/2007 2 ;;3.0;DSS EXTRACTS;**1,8,17,24,33,35,39,46,49,84,107**;Dec 22, 1997;Build 9 3 3 BEG ;entry point from option 4 4 D SETUP I ECFILE="" Q … … 37 37 ..D:ECXTRTL'=ECXTRTN PREVTRT^ECXTRT1(.LOC,ECD1,ECD2,ECXTRTL,.ECXLOS) 38 38 ..;whether ts has changed or not, see if primary provider has changed 39 ..;don 't bother if there's no data on current primary provider or no change in provider39 ..;dont bother if there's no data on current primary provider or no change in provider 40 40 ..D:(ECXPRVN'="")&(ECXPRVN'=ECXPRVL) PREVPRV^ECXTRT1(.LOC,ECD1,ECXPRVN,ECD2,.ECXPRVL,.ECXLOSP) 41 41 ..;whether ts has changed or not, see if attending physician has changed 42 ..;don 't bother if there's no data on current attending physician or no change in attending42 ..;dont bother if theres no data on current attending physician or no change in attending 43 43 ..D:(ECXATTN'="")&(ECXATTN'=ECXATTL) PREVATT^ECXTRT1(.LOC,ECD1,ECXATTN,ECD2,.ECXATTL,.ECXLOSA) 44 44 ..S ECXDATE=$$ECXDATE^ECXUTL(ECXMVD1,ECXYM),ECXTIME=$$ECXTIME^ECXUTL(ECXMVD1) … … 47 47 ..S ECXPDIV="" 48 48 ..I ECXLOGIC>2003 S ECXPDIV=$S(WRD="":"",1:$$NPDIV(WRD)) 49 ..S (ECXALNPI,ECXANNPI,ECXPLNPI,ECXPNNPI)="" 49 50 ..; 50 51 ..;- Observation patient indicator (YES/NO) … … 56 57 ..;- Get providers person classes 57 58 .. S ECXATLPC=$$PRVCLASS^ECXUTL($E(ECXATTL,2,999),ECXADT) 58 .. S ECATLNPI=$$NPI^XUSNPI("Individual_ID",$E(ECXATTL,2,999),ECXADT)59 .. S:+ECATLNPI'>0 ECATLNPI="" S ECATLNPI=$P(ECATLNPI,U)60 59 .. S ECXPRNPC=$$PRVCLASS^ECXUTL($E(ECXPRVN,2,999),ECXADT) 61 .. S ECPRVNPI=$$NPI^XUSNPI("Individual_ID",$E(ECXPRVN,2,999),ECXADT)62 .. S:+ECPRVNPI'>0 ECPRVNPI="" S ECPRVNPI=$P(ECPRVNPI,U)63 60 .. S ECXATNPC=$$PRVCLASS^ECXUTL($E(ECXATTN,2,999),ECXADT) 64 .. S ECATTNPI=$$NPI^XUSNPI("Individual_ID",$E(ECXATTN,2,999),ECXADT)65 .. S:+ECATTNPI'>0 ECATTNPI="" S ECATTNPI=$P(ECATTNPI,U)66 61 .. S ECXPRLPC=$$PRVCLASS^ECXUTL($E(ECXPRVL,2,999),ECXADT) 67 .. S ECPRLNPI=$$NPI^XUSNPI("Individual_ID",$E(ECXPRVL,2,999),ECXADT)68 .. S:+ECPRLNPI'>0 ECPRLNPI="" S ECPRLNPI=$P(ECPRLNPI,U)69 62 ..; 70 63 ..;- If no encounter number, don't file record 71 64 ..S ECXENC=$$ENCNUM^ECXUTL4(ECXA,ECXSSN,ECXADT,,ECXTS,ECXOBS,ECHEAD,,) 72 ..D:ECXENC'="" FILE ^ECXTRT265 ..D:ECXENC'="" FILE 73 66 ;for nhcu episodes with intervening asih stays, the los calculated here is not accurate, 74 67 ;but it never has been; this is best solution within current extract framework; 75 ;at discharge the los calculated for nhcu episodes will be the los since admission w/o asih los subtracted;68 ;at discharge the los calculated for nhcu apisodes will be the los since admission w/o asih los subtracted; 76 69 ; 77 70 ;loop through discharges to get last treating specialty … … 109 102 ..S ECXPDIV="" 110 103 ..I ECXLOGIC>2003 S ECXPDIV=$S(WRD="":"",1:$$NPDIV(WRD)) 104 ..S (ECXALNPI,ECXANNPI,ECXPLNPI,ECXPNNPI)="" 111 105 ..; 112 106 ..;- Observation patient indicator (YES/NO) … … 118 112 ..;- Get providers person classes 119 113 .. S ECXATLPC=$$PRVCLASS^ECXUTL($E(ECXATTL,2,999),ECXADT) 120 .. S ECATLNPI=$$NPI^XUSNPI("Individual_ID",$E(ECXATTL,2,999),ECXADT)121 .. S:+ECATLNPI'>0 ECATLNPI="" S ECATLNPI=$P(ECATLNPI,U)122 114 .. S ECXPRNPC=$$PRVCLASS^ECXUTL($E(ECXPRVN,2,999),ECXADT) 123 .. S ECPRVNPI=$$NPI^XUSNPI("Individual_ID",$E(ECXPRVN,2,999),ECXADT)124 .. S:+ECPRVNPI'>0 ECPRVNPI="" S ECPRVNPI=$P(ECPRVNPI,U)125 115 .. S ECXATNPC=$$PRVCLASS^ECXUTL($E(ECXATTN,2,999),ECXADT) 126 .. S ECATTNPI=$$NPI^XUSNPI("Individual_ID",$E(ECXATTN,2,999),ECXADT)127 .. S:+ECATTNPI'>0 ECATTNPI="" S ECATTNPI=$P(ECATTNPI,U)128 116 .. S ECXPRLPC=$$PRVCLASS^ECXUTL($E(ECXPRVL,2,999),ECXADT) 129 .. S ECPRLNPI=$$NPI^XUSNPI("Individual_ID",$E(ECXPRVL,2,999),ECXADT)130 .. S:+ECPRLNPI'>0 ECPRLNPI="" S ECPRLNPI=$P(ECPRLNPI,U)131 117 ..; 132 118 ..;- If no encounter number don't file record 133 119 ..S ECXENC=$$ENCNUM^ECXUTL4(ECXA,ECXSSN,ECXADT,,ECXTS,ECXOBS,ECHEAD,,) 134 ..D:ECXENC'="" FILE ^ECXTRT2120 ..D:ECXENC'="" FILE 135 121 D KPATDEM^ECXUTL2 136 122 Q … … 178 164 Q 179 165 ; 166 FILE ;file the extract record 167 ;node0 168 ;^dfn^ssn^name^i/o (ECXA)^date^product^adm date^d/c date^ 169 ;mov#^type^new ts^losing ts^losing ts los^ 170 ;losing attending^movement type^time^adm time^new provider^ 171 ;new attending^losing provider 172 ;node1 173 ;mpi^dss dept^losing attending npi^new provider npi^new attending npi^ 174 ;losing provider npi^losing attending los^losing provider los^dom^ 175 ;observ pat ind^encounter num 176 ; 177 ;convert specialties to PTF Codes for transmission 178 ; 179 N ECXDATA 180 S ECXDATA=$$TSDATA^DGACT(42.4,+ECXSPCN,.ECXDATA) 181 S ECXSPCN=$G(ECXDATA(7)) 182 S ECXDATA=$$TSDATA^DGACT(42.4,+ECXSPCL,.ECXDATA) 183 S ECXSPCL=$G(ECXDATA(7)) 184 ;done 185 S EC7=$O(^ECX(ECFILE,999999999),-1),EC7=EC7+1 186 S ECODE=EC7_U_EC23_U_U_ECXDFN_U_ECXSSN_U_ECXPNM_U_ECXA_U_ECXDATE_U_U 187 S ECODE=ECODE_ECXADMDT_U_ECXDCDT_U_ECDA_U_6_U_ECXSPCN_U_ECXSPCL_U 188 S ECODE=ECODE_ECXLOS_U_ECXATTL_U_ECMT_U_ECXTIME_U_ECXADMTM_U_ECXPRVN_U 189 S ECODE=ECODE_ECXATTN_U_ECXPRVL_U 190 S ECODE1=ECXMPI_U_ECXDSSD_U_ECXALNPI_U_ECXPNNPI_U_ECXANNPI_U_ECXPLNPI_U 191 S ECODE1=ECODE1_ECXLOSA_U_ECXLOSP_U_ECXDOM_U_ECXOBS_U_ECXENC_U_ECXPDIV 192 I ECXLOGIC>2005 S ECODE1=ECODE1_U_ECXATLPC_U_ECXPRNPC_U_ECXATNPC_U_ECXPRLPC 193 S ^ECX(ECFILE,EC7,0)=ECODE,^ECX(ECFILE,EC7,1)=ECODE1,ECRN=ECRN+1 194 S DA=EC7,DIK="^ECX("_ECFILE_"," D IX1^DIK K DIK,DA 195 I $D(ZTQUEUED),$$S^%ZTLOAD S QFLG=1 196 Q 197 ; 180 198 SETUP ;Set required input for ECXTRAC 181 199 S ECHEAD="TRT" -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECXUD.m
r628 r636 1 ECXUD ;ALB/JAP,BIR/DMA,PTD-Extract from UNIT DOSE EXTRACT DATA File (#728.904) ; 10/31/07 1:58pm2 ;;3.0;DSS EXTRACTS;**10,8,24,33,39,46,49,71,84,92,107 ,105**;Dec 22, 1997;Build 701 ECXUD ;ALB/JAP,BIR/DMA,PTD-Extract from UNIT DOSE EXTRACT DATA File (#728.904) ;4/19/2007 2 ;;3.0;DSS EXTRACTS;**10,8,24,33,39,46,49,71,84,92,107**;Dec 22, 1997;Build 9 3 3 BEG ;entry point from option 4 4 I '$O(^ECX(728.904,"A",0)) W !,"There are no unit dose orders to extract",!! R X:5 K X Q … … 24 24 Q:ECXERR 25 25 ; 26 S ECXPRO=$P(DATA,U,7),ECPROIEN=+ECXPRO,ECXPRO=$E($P(ECXPRO,";",2))_$P(ECXPRO,";") 27 S ECXPRNPI=$$NPI^XUSNPI("Individual_ID",ECPROIEN,ECD) 28 S:+ECXPRNPI'>0 ECXPRNPI="" S ECXPRNPI=$P(ECXPRNPI,U) 29 S W=$P(DATA,U,6) 26 S ECXPRO=$P(DATA,U,7),ECXPRO=$E($P(ECXPRO,";",2))_$P(ECXPRO,";") 27 S ECXPRNPI="",W=$P(DATA,U,6) 30 28 S ECXDIV=$P($G(^DIC(42,+W,0)),U,11),ECXW=$P($G(^DIC(42,+W,44)),U) 31 29 S ECXUDDT=$$ECXDATE^ECXUTL($P(DATA,U,3),ECXYM) … … 65 63 PAT(ECXDFN,ECXDATE,ECXERR) ;get demographics from patient file 66 64 ;init variables 67 S (ECXCAT,ECXSTAT,ECXPRIOR,ECXSBGRP ,ECXOEF,ECXOEFDT)=""65 S (ECXCAT,ECXSTAT,ECXPRIOR,ECXSBGRP)="" 68 66 ;get patient data if saved 69 67 I $D(^TMP($J,"ECXP",ECXDFN)) D … … 78 76 .S ECXSTAT=$P(PT,U,22),ECXPRIOR=$P(PT,U,23),ECXHNCI=$P(PT,U,24) 79 77 .S ECXETH=$P(PT,U,25),ECXRC1=$P(PT,U,26),ECXMTST=$P(PT,U,27) 80 .S PT1=$G(^TMP($J,"ECXP",ECXDFN,1)),ECXERI=$P(PT1,U),ECXEST=$P(PT1,U,2) ,ECXOEF=$P(PT1,U,3),ECXOEFDT=$P(PT1,U,4)78 .S PT1=$G(^TMP($J,"ECXP",ECXDFN,1)),ECXERI=$P(PT1,U),ECXEST=$P(PT1,U,2) 81 79 .I $$ENROLLM^ECXUTL2(ECXDFN) 82 80 ;set patient data … … 93 91 .S ECXPHI=ECXPAT("PHI"),ECXMST=ECXPAT("MST STAT") 94 92 .S ECXENRL=ECXPAT("ENROLL LOC"),ECXMTST=ECXPAT("MEANS") 95 .;OEF/OIF data96 .S ECXOEF=ECXPAT("ECXOEF")97 .S ECXOEFDT=ECXPAT("ECXOEFDT")98 93 .;get CNHU status 99 94 .S ECXCNHU=$$CNHSTAT^ECXUTL4(ECXDFN) … … 111 106 .S ^TMP($J,"ECXP",ECXDFN)=ECXPNM_U_ECXSSN_U_ECXMPI_U_ECXDOB_U_ECXELIG_U_ECXSEX_U_ECXSTATE_U_ECXCNTY_U_ECXZIP_U_ECXVET_U_ECXPOS_U_ECXPST_U_ECXPLOC_U_ECXRST_U_ECXAST 112 107 .S ^TMP($J,"ECXP",ECXDFN)=^TMP($J,"ECXP",ECXDFN)_U_ECXAOL_U_ECXPHI_U_ECXMST_U_ECXENRL_U_ECXCNHU_U_ECXCAT_U_ECXSTAT_U_ECXPRIOR_U_ECXHNCI_U_ECXETH_U_ECXRC1_U_ECXMTST 113 .S ^TMP($J,"ECXP",ECXDFN,1)=ECXERI_U_ECXEST _U_ECXOEF_U_ECXOEFDT108 .S ^TMP($J,"ECXP",ECXDFN,1)=ECXERI_U_ECXEST 114 109 ; 115 110 ;get inpatient data … … 144 139 ;elig ECXCVE^combat vet elig end date ECXCVEDT^enc cv eligible 145 140 ;ECXCVENC^national patient record flag ECXNPRFI^emerg resp indic(FEMA) 146 ;ECXERI^environ contamin ECXEST ^OEF/OIF ECXOEF^OEF/OIF return date ECXOEFDT^associate pc provider npi ECASNPI^primary care provider npi ECPTNPI^provider npi ECXPRNPI141 ;ECXERI^environ contamin ECXEST 147 142 N DA,DIK 148 143 S EC7=$O(^ECX(ECFILE,999999999),-1),EC7=EC7+1 … … 157 152 S ECODE=ECODE_$$ECXDATE^ECXUTL(ECXADM,ECXYM)_U 158 153 S ECODE=ECODE_$$ECXTIME^ECXUTL(ECXADM)_U 159 S ECODE1=ECXMPI_U_ECXDSSD_U_ U_ECXDOM_U_ECXOBS_U_ECXENC_U154 S ECODE1=ECXMPI_U_ECXDSSD_U_ECXPRNPI_U_ECXDOM_U_ECXOBS_U_ECXENC_U 160 155 S ECODE1=ECODE1_ECXPDIV_U_ECXMTST_U_ECXELIG_U_ECXDOB_U_ECXSEX_U 161 156 S ECODE1=ECODE1_ECXSTATE_U_ECXCNTY_U_ECXZIP_U_ECXVET_U_ECXPOS_U … … 163 158 S ECODE1=ECODE1_ECXAOL_U_ECXPHI_U_ECXMST_U_ECXCNHU_U_ECXENRL_U 164 159 S ECODE1=ECODE1_ECXCAT_U_ECXSTAT_U_$S(ECXLOGIC<2005:ECXPRIOR,1:"")_U_ECPTTM_U_ECPTPR_U 165 S ECODE1=ECODE1_ U_ECCLAS_U_ECASPR_U_U_ECCLAS2_U160 S ECODE1=ECODE1_ECPTNPI_U_ECCLAS_U_ECASPR_U_ECASNPI_U_ECCLAS2_U 166 161 S ECODE2=ECXORDDT_U_ECXORDST_U_ECXHNCI_U_ECXETH_U_ECXRC1 167 162 I ECXLOGIC>2003 S ECODE2=ECODE2_U_ECXBCDD_U_ECXBCDG_U_ECXBCUA_U_ECXBCIF_U_ECXOPPC 168 163 I ECXLOGIC>2004 S ECODE2=ECODE2_U_U_ECXPRIOR_ECXSBGRP_U_ECXUESTA_U_ECXPTYPE_U_ECXCVE_U_ECXCVEDT_U_ECXCVENC_U_ECXNPRFI 169 164 I ECXLOGIC>2006 S ECODE2=ECODE2_U_ECXERI_U_ECXEST 170 I ECXLOGIC>2007 S ECODE2=ECODE2_U_ECXOEF_U_ECXOEFDT_U_ECASNPI_U_ECPTNPI_U_ECXPRNPI171 165 S ^ECX(ECFILE,EC7,0)=ECODE,^ECX(ECFILE,EC7,1)=ECODE1 172 166 S ^ECX(ECFILE,EC7,2)=ECODE2,ECRN=ECRN+1 -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECXUPRO.m
r628 r636 1 ECXUPRO ;ALB/TJL-Prosthetic Extract Unusual Cost Report ; 1/08/081:00pm2 ;;3.0;DSS EXTRACTS;**49 ,111**;July 1, 2003;Build 41 ECXUPRO ;ALB/TJL-Prosthetic Extract Unusual Cost Report ; 7/1/03 1:00pm 2 ;;3.0;DSS EXTRACTS;**49**;July 1, 2003 3 3 ; 4 4 EN ; entry point … … 77 77 ; 78 78 PRINT ; process temp file and print report 79 N PG,QFLG,GTOT,LN,COUNT,FKEY,COST,SSN,REC ,SDAY79 N PG,QFLG,GTOT,LN,COUNT,FKEY,COST,SSN,REC 80 80 U IO 81 81 I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1 K ZTREQ Q … … 85 85 F S FKEY=$O(^TMP($J,FKEY)) Q:FKEY=""!QFLG D 86 86 .S COST="" F S COST=$O(^TMP($J,FKEY,COST)) Q:COST=""!QFLG D 87 .. S SDAY="" F S SDAY=$O(^TMP($J,FKEY,COST,SDAY)) Q:SDAY=""!QFLG D 88 ...S SSN="" F S SSN=$O(^TMP($J,FKEY,COST,SDAY,SSN)) Q:SSN=""!QFLG S REC=^(SSN) D 89 ....S COUNT=COUNT+1 90 ....I $Y+3>IOSL D HEADER Q:QFLG 91 ....W !,$P(REC,U),?8,$P(REC,U,2),?21,$P(REC,U,3),?39,$P(REC,U,4),?70,$P(REC,U,5),?93,$$RJ^XLFSTR($P(REC,U,6),8),?110,$$RJ^XLFSTR($P(REC,U,7),11) 87 ..S SSN="" F S SSN=$O(^TMP($J,FKEY,COST,SSN)) Q:SSN=""!QFLG S REC=^(SSN) D 88 ...S COUNT=COUNT+1 89 ...I $Y+3>IOSL D HEADER Q:QFLG 90 ...W !,$P(REC,U),?8,$P(REC,U,2),?21,$P(REC,U,3),?39,$P(REC,U,4),?70,$P(REC,U,5),?93,$$RJ^XLFSTR($P(REC,U,6),8),?110,$$RJ^XLFSTR($P(REC,U,7),11) 92 91 Q:QFLG 93 92 I COUNT=0 W !!,?8,"No unusual costs to report for this extract" -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECXUPRO1.m
r628 r636 1 ECXUPRO1 ;ALB/TJL-Prosthetics Extract Unusual Cost Report; 01/08/082:49pm2 ;;3.0;DSS EXTRACTS;**49 ,111**;Jul 2, 2003;Build 41 ECXUPRO1 ;ALB/TJL-Prosthetics Extract Unusual Cost Report; 7/2/03 2:49pm 2 ;;3.0;DSS EXTRACTS;**49**;Jul 2, 2003 3 3 ; 4 4 EN ; entry point … … 48 48 S:(+PROQTY=0) PROQTY=1 49 49 S PROQTY=$$RJ^XLFSTR(PROQTY,8,0) 50 S ^TMP($J,ECXFEKEY,-PROQTY, SUBDA,PROSSN)=PRONAME_U_PROSSN_U_PRODAY_U_ECXHCPCS_U_ECXFEKEY_U_PROQTY_U_"$"_$FNUMBER(PROCOST,",",2)50 S ^TMP($J,ECXFEKEY,-PROQTY,PROSSN)=PRONAME_U_PROSSN_U_PRODAY_U_ECXHCPCS_U_ECXFEKEY_U_PROQTY_U_"$"_$FNUMBER(PROCOST,",",2) 51 51 S COUNT=COUNT+1 52 52 I COUNT#100=0 I $$S^ZTLOAD S (ZSTOP,ECXERR)=1 -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECXUSUR.m
r628 r636 1 ECXUSUR ;ALB/TJL-Surgery Extract Unusual Volume Report ; 9/4/07 8:19am2 ;;3.0;DSS EXTRACTS;**49,71,84,93 ,105**;July 1, 2003;Build 701 ECXUSUR ;ALB/TJL-Surgery Extract Unusual Volume Report ; 4/11/06 10:44AM 2 ;;3.0;DSS EXTRACTS;**49,71,84,93**;July 1, 2003 3 3 ; 4 4 EN ; entry point … … 89 89 ..S COUNT=COUNT+1 90 90 ..I $Y+3>IOSL D HEADER Q:QFLG 91 ..W !,?1,$P(REC,U),?7,$P(REC,U,2),?18,$P(REC,U,3),?27,$P(REC,U,4) 92 ..W ?34,$P(REC,U,5),?55,$$RJ^XLFSTR($P(REC,U,7),4) 93 ..W ?66,$$RJ^XLFSTR($P(REC,U,11),4),?77,$$RJ^XLFSTR($P(REC,U,9),4) 94 ..W ?86,$$RJ^XLFSTR($P(REC,U,10),4),?93,$$RJ^XLFSTR($P(REC,U,6),4) 95 ..W ?103,$$RJ^XLFSTR($P(REC,U,8),4),?113,$P(REC,U,14) 96 ..W ?117,$P(REC,U,13) 91 ..W !,$P(REC,U),?6,$P(REC,U,2),?17,$P(REC,U,3),?26,$P(REC,U,4) 92 ..W ?33,$P(REC,U,5),?55,$$RJ^XLFSTR($P(REC,U,9),4) 93 ..W ?63,$$RJ^XLFSTR($P(REC,U,10),4),?74,$$RJ^XLFSTR($P(REC,U,11),4) 94 ..W ?83,$$RJ^XLFSTR($P(REC,U,6),4),?90,$$RJ^XLFSTR($P(REC,U,8),4) 95 ..W ?101,$$RJ^XLFSTR($P(REC,U,7),4),?114,$P(REC,U,13) 97 96 Q:QFLG 98 97 I COUNT=0 W !!,?8,$S(ECXFLAG=1:"No surgery volumes to report for this extract",1:"No unusual volumes to report for this extract") … … 113 112 W !,"Start Date: ",ECSTART,?97,"Report Run Date/Time: "_ECRUN 114 113 W !," End Date: ",ECEND I 'ECXFLAG W ?97," Threshold Value: ",ECTHLD 115 W !!,?2 8,"Case",?38,"Encounter",?52,"Pt Holding",?63,"Anesthesia",?75,"Patient",?83,"Operation",?93,"PACU",?101,"OR Clean",?111,"Canc/",?121,"Principal"116 W !, ?1,"Name",?10,"SSN",?20,"Day",?27,"Number",?40,"Number"117 W ?5 4,"Time",?66,"Time",?77,"Time",?86,"Time",?93,"Time",?103,"Time"118 W ?11 1,"Abort",?121,"Procedure"114 W !!,?27,"Case",?37,"Encounter",?53,"Patient",?61,"Operation",?71,"Anesthesia",?83,"PACU",?89,"OR Clean",?99,"Pt Holding",?114,"Principal" 115 W !,"Name",?9,"SSN",?19,"Day",?26,"Number",?39,"Number" 116 W ?55,"Time",?63,"Time",?74,"Time",?83,"Time",?90,"Time",?101,"Time" 117 W ?114,"Procedure" 119 118 W !,LN,! 120 119 Q -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECXUSUR1.m
r628 r636 1 ECXUSUR1 ;ALB/TJL-Surgery Extract Unusual Volume Report ; 1 /8/08 9:58am2 ;;3.0;DSS EXTRACTS;**49,71 ,105,111**;July 1, 2003;Build 41 ECXUSUR1 ;ALB/TJL-Surgery Extract Unusual Volume Report ; 12/1/04 4:48pm 2 ;;3.0;DSS EXTRACTS;**49,71**;July 1, 2003 3 3 EN ; 4 4 N ECHEAD,COUNT,TIMEDIF,ECXPROC … … 62 62 S ECODE0=TIME_U_ECODE0 K TIME 63 63 ; 64 I ECNL]"" S $P(ECODE0,U,2)=ECNT 65 ; 66 ;- Was surgery cancelled/aborted 67 S ECCAN=$P($G(^SRF(ECD0,30)),U) 68 I +ECCAN S ECCAN=$$CANC^ECXUTL4(ECNL,$P(DATA2,U,10)) 64 I ECNL]"" S $P(ECODE0,U,5)=ECNT 69 65 ; 70 66 I ECXFLAG D FILE Q … … 74 70 . I $P(ECODE0,U,PIECE)>ECTHLD S FILE="YES" 75 71 . I $P(ECODE0,U,PIECE)<0 S FILE="YES" 76 ;77 72 I FILE="YES" D FILE Q:ECXERR 78 73 Q … … 95 90 S ECXENC=$$ENCNUM^ECXUTL4(ECXA,ECXSSN,ECXADMDT,ECXDATE,ECXTS,ECXOBS,ECHEAD,ECXSTOP,ECSS) Q:ECXENC="" 96 91 ; 97 S VOL=$P(ECODE0,U )98 I $P(ECODE0,U, 2)>VOL S VOL=$P(ECODE0,U,2)99 I $P(ECODE0,U, 3)>VOL S VOL=$P(ECODE0,U,3)100 S ^TMP($J,-VOL,-ECD0)=SURNAME_U_SURSSN_U_SURDT_U_ECD0_U_ECXENC_U_ECODE0_U_ECXPROC _U_ECCAN92 S VOL=$P(ECODE0,U,4) 93 I $P(ECODE0,U,5)>VOL S VOL=$P(ECODE0,U,5) 94 I $P(ECODE0,U,6)>VOL S VOL=$P(ECODE0,U,6) 95 S ^TMP($J,-VOL,-ECD0)=SURNAME_U_SURSSN_U_SURDT_U_ECD0_U_ECXENC_U_ECODE0_U_ECXPROC 101 96 S COUNT=COUNT+1 102 97 I COUNT#100=0 I $$S^ZTLOAD S (ZSTOP,ECXERR)=1 -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECXUTL2.m
r628 r636 1 ECXUTL2 ;ALB/JAP - Utilities for DSS Extracts (cont.) ; 6/12/07 6:38am2 ;;3.0;DSS EXTRACTS;**8,13,23,24,33,35,39,46,71,84,92 ,105**;Dec 22, 1997;Build 701 ECXUTL2 ;ALB/JAP - Utilities for DSS Extracts (cont.) ; 11/2/06 9:03am 2 ;;3.0;DSS EXTRACTS;**8,13,23,24,33,35,39,46,71,84,92**;Dec 22, 1997;Build 30 3 3 ; 4 4 ECXDEF(ECXHEAD,ECXPACK,ECXGRP,ECXFILE,ECXRTN,ECXPIECE,ECXVER) ;variables specific to extract from file #727.1 … … 13 13 ; ECXPIECE= running piece field (#11) 14 14 ; ECXVER = dss version 15 ; 15 16 N ECXIEN,ECXARR,DIC,DA,DR,DIQ 16 17 S (ECXPACK,ECXGRP,ECXFILE,ECXRTN,ECXPIECE,ECXVER)="",ECXIEN=0 … … 49 50 S ECXVER=7 50 51 Q 52 ; 51 53 PATDEM(DFN,DT1,PAR,FLG) ; determine patient information 52 54 ; DFN = … … 76 78 .S ECXEST=PAT("EC STAT"),ECXPST=PAT("POW STAT"),ECXPLOC=PAT("POW LOC") 77 79 .S ECXPHI=PAT("PHI"),ECXMST=PAT("MST STAT"),ECXAOL=PAT("AOL") 78 .S ECXOEF=PAT("ECXOEF"),ECXOEFDT=PAT("ECXOEFDT")79 80 I PAR["6" D 80 81 .S (ECXPAYOR,ECXSAI)="" D VISN19(DFN,.ECXPAYOR,.ECXSAI) … … 97 98 K ECXSBGRP 98 99 Q 100 ; 99 101 ENROLLM(DFN,RNDT) ;determines enrollment status, category, priority 100 102 ;and user enrollee status … … 109 111 ; ECXUESTA = User enrollee 110 112 ; return value 0 if no data found, 1 if data found 113 ; 111 114 N CAT,PRIOR,STAT,X,X1,X2,X3,ENRIEN,ENR,FL,SBGRP 112 115 S (ECXCAT,ECXPRIOR,ECXSTAT,ECXSBGRP,ECXEUSTA)="" … … 139 142 S ECXSTAT=STAT,ECXPRIOR=PRIOR,ECXCAT=CAT,ECXSBGRP=$S(SBGRP=1:"a",SBGRP=3:"c",SBGRP=5:"e",SBGRP=7:"g",1:"") 140 143 Q 1 144 ; 141 145 PRIMARY(ECXDFN,ECXDATE,ECXPREFX) ;determine patient's pc team and pc provider 142 146 ; input … … 146 150 ; defaults to "2" if not specified otherwise 147 151 ; output 148 ; ECXPRIME = pc team ien^prefix_pc provider ien^pc provider person 149 ; class^pc provider npi^prefix_assoc pc provider ien^assoc pc provider150 ; person class^assoc pc provider npi152 ; ECXPRIME = pc team ien^prefix_pc provider ien^pc provider person class^pc provider npi 153 ; ^prefix_assoc pc provider ien^assoc pc provider person class^assoc pc provider npi 154 ; 151 155 N ECPTTM,ECPTPR,ECCLAS,ECPRIME,ECASPR,ECCLAS2 152 156 S:'$D(ECXPREFX) ECXPREFX=2 S:(+ECXPREFX=0) ECXPREFX=2 … … 156 160 S ECPTPR=+$$OUTPTPR^SDUTL3(ECXDFN,ECXDATE) 157 161 S ECCLAS="" I ECPTPR>0 S ECCLAS=$$PRVCLASS^ECXUTL(ECPTPR,ECXDATE) 158 N ECXUSRTN S ECXUSRTN=$$NPI^XUSNPI("Individual_ID",ECPTPR,ECXDATE)159 S:+ECXUSRTN'>0 ECXUSRTN="" S ECPTNPI=$P(ECXUSRTN,U)160 162 S:ECPTPR=0 ECPTPR="" S:ECPTPR]"" ECPTPR=ECXPREFX_ECPTPR 163 S ECPTNPI="" 161 164 ;assoc pc provider call ok if routine scapmca from patch177 is present 162 165 S ECASPR="" … … 164 167 .S ECASPR=+$$OUTPTAP^SDUTL3(ECXDFN,ECXDATE) 165 168 S ECCLAS2="" I ECASPR>0 S ECCLAS2=$$PRVCLASS^ECXUTL(ECASPR,ECXDATE) 166 N ECXUSRTN S ECXUSRTN=$$NPI^XUSNPI("Individual_ID",ECASPR,ECXDATE)167 S:+ECXUSRTN'>0 ECXUSRTN="" S ECASNPI=$P(ECXUSRTN,U)168 169 S:ECASPR=0 ECASPR="" S:ECASPR]"" ECASPR=ECXPREFX_ECASPR 170 S ECASNPI="" 169 171 ;assemble 170 172 S ECXPRIME=ECPTTM_U_ECPTPR_U_ECCLAS_U_ECPTNPI_U_ECASPR_U_ECCLAS2_U_ECASNPI 171 173 Q ECXPRIME 174 ; 172 175 INP(ECXDFN,ECXDATE) ; check for inpatient status 173 176 ; input … … 182 185 ; where patient status = I for inpatient 183 186 ; = O for outpatient 187 ; 184 188 N DFN,DSSDEPT,ECA,ECADM,ECMN,ECTS,ECWARD,ECDC,ECXINP,ECXPRO 185 189 N ECXATP,ECXDD,ECXDOM,ECXPROF,ECXPWP,ECXWW,FAC,VAIP,WRD,ECXPWPPC … … 187 191 D FIELD^DID(405,.19,,"SPECIFIER","ECXDD") 188 192 S ECXPROF=$E(+$P(ECXDD("SPECIFIER"),"P",2)) K ECXDD 193 ; 189 194 ;- Inpat/outpat indicator (ECA) initially set to "O" (outpatient) 190 195 S DFN=ECXDFN,ECA="O" … … 194 199 I ECMN D 195 200 .S ECTS=+$P($G(^DIC(45.7,+VAIP(8),0)),U,2) S:ECTS=0 ECTS="" 201 .; 196 202 .;- Get inpat/outpat indicator 197 203 .S ECA=$$INOUTP^ECXUTL4(ECTS) … … 212 218 S ECXINP=ECA_U_ECMN_U_ECTS_U_ECADM_U_ECWARD_U_ECDC_U_ECXPWP_U_ECXATP_U_ECXWW_U_ECXDOM_U_ECXPWPPC_U_ECXATPPC 213 219 Q ECXINP 220 ; 214 221 VISN19(ECXDFN,ECXPAYOR,ECXSAI) ;visn 19 sharing agreement data 215 222 ; input ECXDFN = patient file ien 216 223 ; output ECXPAYOR, ECXSAI (passed by reference) 224 ; 217 225 N JJ,ALIAS,INSUR,DIC,DIQ,DA,DR,ECXARY,ECXERR,ECXDA 218 226 S (ECXPAYOR,ECXSAI)="" … … 226 234 ;K ECXARY,ECXERR 227 235 I ECXPAYOR]"" D GETS^DIQ(2,ECXDFN,".3121*,","I","ECXARY","ECXERR") D 236 . W !,"This is a test" 228 237 . I $D(ECXERR) Q 229 238 . S JJ=0,ECXDA=$O(ECXARY(2.312,JJ)) I ECXDA="" Q -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECXUTL3.m
r628 r636 1 ECXUTL3 ;ALB/GTS - Utilities for DSS Extracts ; 9/28/07 1:38pm2 ;;3.0;DSS EXTRACTS;**11,24,32,33,35,37,39,42,46,92 ,105**;Dec 22,1997;Build 701 ECXUTL3 ;ALB/GTS - Utilities for DSS Extracts ; 11/2/06 9:07am 2 ;;3.0;DSS EXTRACTS;**11,24,32,33,35,37,39,42,46,92**;Dec 22,1997;Build 30 3 3 ; 4 4 OUTPTTM(ECXDFN,ECXDT) ;* Return PC Team from PCMM files or DPT … … 69 69 I ECXDFN="" Q 0 70 70 S SSN=$$GET1^DIQ(2,ECXDFN,.09,"I"),DFN=ECXDFN,ECXPAT=0 71 I $E(SSN,1,3)="000"!(SSN="") K ECXPAT Q 0 ;test patient 72 ;test patient extended checks; mtl extract excluded 73 I $G(ECHEAD)'="MTL",'$$SSN^ECXUTL5(SSN) K ECXPAT Q 0 71 I $E(SSN,1,5)="00000"!(SSN="") K ECXPAT Q 0 ;test patient 74 72 S STR="NAME;SSN;DOB;SEX;RACE;RELIGION;STATE;COUNTY;ZIP;SC%;MEANS;ELIG;" 75 73 S STR=STR_"EMPLOY;AO STAT;IR STAT;EC STAT;POW STAT;POW LOC;MST STAT;" … … 149 147 . ;- Agent Orange Location (K=Korean DMZ,V=Vietnam) 150 148 . S ECXPAT("AOL")=$P($G(VASV(2,5)),U) 151 . ;get patient OEF/OIF status and date of return152 . D OEFDATA^ECXUTL4153 . ;154 149 . ;get patient current MST status 155 150 . I ECXDATE'="",ECXDATE'["." S ECXDATE=ECXDATE+.9 -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECXUTL4.m
r628 r636 1 ECXUTL4 ;ALB/ESD - Utilities for DSS Extracts ; 11/2 6/07 10:58am2 ;;3.0;DSS EXTRACTS;**39,41,46,49,78,92 ,105**;Dec 22,1997;Build 701 ECXUTL4 ;ALB/ESD - Utilities for DSS Extracts ; 11/2/06 9:08am 2 ;;3.0;DSS EXTRACTS;**39,41,46,49,78,92**;Dec 22,1997;Build 30 3 3 ; 4 4 OBSPAT(ECXIO,ECXTS,DSSID) ; … … 271 271 F I=1:1:$L(TS) Q:$P(TS,"^",I)=ECXTS 272 272 Q $P(SC,"^",I)_"000" 273 OEFDATA ;274 ;get patient OEF/OIF status and date of return275 S (ECXOEF,ECXOEFDT)=""276 I $G(VASV(11))>0 S ECXOEF=ECXOEF_"OIF"277 I $G(VASV(12))>0 S ECXOEF=ECXOEF_"OEF"278 I $G(VASV(13))>0 S ECXOEF=ECXOEF_"UNK"279 I ECXOEF'="" D280 . S ECXOEFDT=""281 . I $G(VASV(11))>0 S ECXOEFDT=$P($G(VASV(11,$G(VASV(11)),3)),"^")282 . I $G(VASV(12))>0,$P($G(VASV(12,$G(VASV(12)),3)),"^")>ECXOEFDT S ECXOEFDT=$P($G(VASV(12,$G(VASV(12)),3)),"^")283 . I $G(VASV(13))>0,$P($G(VASV(13,$G(VASV(13)),3)),"^")>ECXOEFDT S ECXOEFDT=$P($G(VASV(13,$G(VASV(13)),3)),"^")284 . I ECXOEFDT>0 S ECXOEFDT=17000000+ECXOEFDT285 ;286 S ECXPAT("ECXOEF")=ECXOEF287 S ECXPAT("ECXOEFDT")=ECXOEFDT288 Q -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECXUTL5.m
r628 r636 1 ECXUTL5 ;ALB/JRC - Utilities for DSS Extracts ; 10/17/07 3:49pm2 ;;3.0;DSS EXTRACTS;**71,84,92,103 ,105**;Dec 22, 1997;Build 701 ECXUTL5 ;ALB/JRC - Utilities for DSS Extracts ; 01/18/07 9:04am 2 ;;3.0;DSS EXTRACTS;**71,84,92,103**;Dec 22, 1997;Build 1 3 3 ; 4 4 REPEAT(CHAR,TIMES) ;REPEAT A STRING … … 207 207 D DIQ^PSODI(DIC,DIC,DR,DA,DIQ) 208 208 Q $S($G(ECXDIQ(52,DA,116))="YES":"Y",$G(ECXDIQ(52,DA,116))="NO":"N",1:"") 209 ;210 SSN(SSN,FILE) ; extended validation of ssn211 ; input: ssn - social security number to validate212 ; file - optional "", 2 or 67, the only check is for213 ; reference lab file (#67) in which case ssn214 ; "000123456" is considered a valid ssn.215 ; output: 0 - test patient or invalid ssn216 ; 1 - valid ssn217 ;218 ;check input219 I $G(SSN)']"" Q 0220 S FILE=$G(FILE)221 I (FILE=67)&(SSN="000123456") Q 1222 I "89"[$E(SSN) Q 0223 I (SSN="123456789")!(SSN="111111111")!(SSN="222222222")!(SSN="333333333")!(SSN="444444444")!(SSN="555555555")!($E(SSN,1,3)="666")!($E(SSN,4,5)="00")!($E(SSN,1,3)="000") Q 0224 Q 1 -
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECXUTL6.m
r628 r636 1 ECXUTL6 ;ALB/JRC - Utilities for DSS Extracts ; 11/2 8/07 11:34am2 ;;3.0;DSS EXTRACTS;**92 ,105**;Dec 22, 1997;Build 701 ECXUTL6 ;ALB/JRC - Utilities for DSS Extracts ; 11/2/06 8:30am 2 ;;3.0;DSS EXTRACTS;**92**;Dec 22, 1997;Build 30 3 3 ; 4 4 NUTKEY(P,D) ;Generate n&fs feeder key … … 6 6 ; p - diet type production diet, standing orders, supplemental 7 7 ; feedings, or tube feedings. 8 ; d - diet ien from files 116.2, 11 8.3, 118, or 118.28 ; d - diet ien from files 116.2, 116.3, 118, or 118.2 9 9 ;Check input 10 10 I $G(P)=""!'$G(D) Q "" … … 13 13 S (PRO,IENS,CODE,DIET)=0 14 14 S PRO=$O(^ECX(728.45,"B",P,PRO)) 15 S CODE=D_$S(P="PD":";FH(116.2,",P="SO":";FH(11 8.3,",P="SF":";FH(118,",P="TF":";FH(118.2,",1:"")15 S CODE=D_$S(P="PD":";FH(116.2,",P="SO":";FH(116.3,",P="SF":";FH(118,",P="TF":";FH(118.2,",1:"") 16 16 S DIET=0,DIET=$O(^ECX(728.45,+PRO,1,"B",CODE,DIET)) 17 17 S IENS=""_DIET_","_PRO_","_"" … … 28 28 ; location 29 29 ;Init variables 30 N WARD,TRSVP, CRSVP,OPLOC,MASWARD31 S (CRSVP,TRSVP)=0,(WARD,DLT,DFL,MASWARD)=""30 N WARD,TRSVP,OPLOC,MASWARD 31 S TRSVP=0,(WARD,ECXDLT,ECXDFL,MASWARD)="" 32 32 S OPLOC="" 33 33 ;Check input … … 38 38 ;119.72 (production facility) field 2. 39 39 I P="INP" D 40 .S WARD=$P($G(^FHPT(FHDFN,"A", +ECXADM,0)),U,8)40 .S WARD=$P($G(^FHPT(FHDFN,"A",ECXADM,0)),U,8) 41 41 .S TRSVP=$$GET1^DIQ(119.6,WARD,3,"I") 42 .S CRSVP=$$GET1^DIQ(119.6,WARD,4,"I")43 42 .;Get divisions 44 43 .D GETDIV … … 80 79 I P["OP",D["GM" D 81 80 .S OPLOC=""_$P(NODE,U,5)_","_"",TRSVP=$$GET1^DIQ(119.6,OPLOC,3,"I") 82 .S FPF=$$GET1^DIQ(119.72,""_TRSVP_","_"",2,"I")81 .S ECXFPF=$$GET1^DIQ(119.72,""_TRSVP_","_"",2,"I") 83 82 .;Get delivery division 84 83 .D GETDIV … … 96 95 ; all other meals are null 97 96 I P="INP",D="PD" D 98 .S DLT=$P($G(NODE),U,8)97 .S ECXDLT=$P($G(NODE),U,8) 99 98 I P="OP",((D="RM")!(D="SM")) D 100 .S DLT=$E($$GET1^DIQ(119.6,""_$P(NODE,U,3)_","_"",101,"E"),1)99 .S ECXDLT=$E($$GET1^DIQ(119.6,""_$P(NODE,U,3)_","_"",101,"E"),1) 101 100 I P="OP",D="GM" D 102 .S DLT=$E($$GET1^DIQ(119.6,""_$P(NODE,U,5)_","_"",101,"E"),1)101 .S ECXDLT=$E($$GET1^DIQ(119.6,""_$P(NODE,U,5)_","_"",101,"E"),1) 103 102 ; 104 103 ;Delivery feeder location 105 I DLT="C" D 106 .S DFL=$E($$GET1^DIQ(119.6,WARD,4,"E"),1,10) 107 .S IEN=$$GET1^DIQ(119.72,+CRSVP,2,"I") 108 .S IEN=""_IEN_";FH(119.71," 109 .S FPF=$O(^ECX(728.46,"B",IEN,FPF)) 110 .S FPF=$E($$GET1^DIQ(728.46,FPF,.01,"E"),1,10) 111 I (DLT["T")!(DLT["D") D 112 .I P="INP" D 113 ..S MASWARD=$O(^FH(119.6,+WARD,"W","B",0)) 114 ..S DFL=$$GET1^DIQ(42,+MASWARD,44,"I") 115 .I P="OP" D 116 ..S DFL=$O(^FH(119.6,+OPLOC,"L","B",0)) 117 I (DLT=""),"SFTFSO"[D D 118 .S DFL=$S(TRSVP:$$GET1^DIQ(119.6,WARD,3,"E"),1:$$GET1^DIQ(119.6,WARD,4,"E")) 104 I ECXDLT="C" S ECXDFL=$P(NODE,U,8) D 105 .S ECXDFL=$E($$GET1^DIQ(119.72,ECXDFL,2,"E"),1,10) 106 I (ECXDLT["T")!(ECXDLT["D") D 107 .S MASWARD=$O(^FH(119.6,$S(WARD:+WARD,+OPLOC:+OPLOC,1:""),"W","B",0)) 108 .S ECXDFL=$$GET1^DIQ(42,+MASWARD,44,"I") 119 109 Q 1 120 110 ; … … 122 112 ;Init variables 123 113 N IEN,SIEN 124 S ( FDD,FPF,FPD)=""114 S (ECXFDD,ECXFPF,ECXFPD)="" 125 115 S IEN=$$GET1^DIQ(119.72,+TRSVP,2,"I") 126 116 Q:'IEN 127 117 ;Get delivery division 128 118 S SIEN=""_+TRSVP_";FH(119.72," 129 S FDD=$O(^ECX(728.46,"B",SIEN,FDD))130 S FDD=""_$$GET1^DIQ(728.46,FDD,1,"I")_","_""131 S FDD=$$GET1^DIQ(4,FDD,99,"E")119 S ECXFDD=$O(^ECX(728.46,"B",SIEN,ECXFDD)) 120 S ECXFDD=""_$$GET1^DIQ(728.46,ECXFDD,1,"I")_","_"" 121 S ECXFDD=$$GET1^DIQ(4,ECXFDD,99,"E") 132 122 ;Get production division and food production facility 133 123 S IEN=""_IEN_";FH(119.71," 134 S FPF=$O(^ECX(728.46,"B",IEN,FPF))135 S FPD=""_$$GET1^DIQ(728.46,FPF,1,"I")_","_""136 S FPD=$$GET1^DIQ(4,FPD,99,"E")137 S FPF=$E($$GET1^DIQ(728.46,FPF,.01,"E"),1,10)124 S ECXFPF=$O(^ECX(728.46,"B",IEN,ECXFPF)) 125 S ECXFPD=""_$$GET1^DIQ(728.46,ECXFPF,1,"I")_","_"" 126 S ECXFPD=$$GET1^DIQ(4,ECXFPD,99,"E") 127 S ECXFPF=$E($$GET1^DIQ(728.46,ECXFPF,.01,"E"),1,10) 138 128 Q 139 ;140 SUR(CRST,STCD,CLINIC) ;Surgery stop codes and clinic (outpatients only)141 ;Init variables142 S (CRST,STCD,CLINIC)=""143 ;Quit if not outpatient144 Q:$P(EC0,U,12)'="O" ""145 ;Get stop codes (outpatient only)146 I $P(EC0,U,12)="O" D147 .;Get credit stop code (outpatient only)148 .S CRST=""_$$GET1^DIQ(40.7,""_$$GET1^DIQ(44,$$GET1^DIQ(137.45,$P(EC0,U,4),2,"I")_","_""_","_"",2503,"I")_","_"",1,"E")149 .;Get stop code (outpatient only)150 .S STCD=""_$$GET1^DIQ(40.7,""_$$GET1^DIQ(44,$$GET1^DIQ(137.45,$P(EC0,U,4),2,"I")_","_""_","_"",8,"I")_","_"",1,"E")151 ;Clinic for non-or case use associated clinic else non-or location152 ;If non-or case153 I $P($G(ECNO),U)="Y" S CLINIC=$S($P(EC0,U,21):$P(EC0,U,21),1:$P(ECNO,U,2))154 ;Get stop codes non-or cases155 I $P($G(ECNO),U)="Y" D156 .;Get credit stop code for non-or case157 .S CRST=$$GET1^DIQ(40.7,$$GET1^DIQ(44,CLINIC,2503,"I"),1,"E")158 .;Get stop code for non-or case159 .S STCD=$$GET1^DIQ(40.7,$$GET1^DIQ(44,CLINIC,8,"I"),1,"E")160 ;Clinic, not a non-or case use surgical specialty associated clinic161 I $P($G(ECNO),U)'="Y" S CLINIC=$$GET1^DIQ(137.45,+$P(EC0,U,4),2,"I")162 Q 1163 ;164 SURPODX(PRODX,PODX1,PODX2,PODX3,PODX4,PODX5) ;Get postop diagnosis codes165 ;Init variables166 N CODE,I,PODX167 S (PRODX,PODX1,PODX2,PODX3,PODX4,PODX5)="",CODE=0168 ;Check input169 Q:'$D(DATAOP) 0170 ;Get principal postop dx code171 S PRODX=$$GET1^DIQ(80,$P(DATAOP,U,3),.01)172 ;Get other postop dx codes173 S (CODE,I)=0 F S CODE=$O(^SRO(136,ECD0,4,CODE)) Q:'CODE Q:I>5 D174 .S I=I+1,PODX="PODX"_I,@PODX=$$GET1^DIQ(80,$P(^SRO(136,ECD0,4,CODE,0),U),.01)175 Q 1
Note:
See TracChangeset
for help on using the changeset viewer.
