| [613] | 1 | ECX347PT ;ALB/ESD - PATCH ECX*3.0*47 Post-Init Rtn ; 11/7/02 1:00pm
|
|---|
| 2 | ;;3.0;DSS EXTRACTS;**47**;Dec 22, 1997
|
|---|
| 3 | ;
|
|---|
| 4 | ;Post-init routine to add new entries to:
|
|---|
| 5 | ; DSS LAB TESTS file (#727.2)
|
|---|
| 6 | ; NATIONAL CLINIC file (#728.441)
|
|---|
| 7 | ;
|
|---|
| 8 | ;
|
|---|
| 9 | EN D ADD7272,POST1
|
|---|
| 10 | Q
|
|---|
| 11 | ;
|
|---|
| 12 | ;
|
|---|
| 13 | ADD7272 ;- Add new entries to file #727.2
|
|---|
| 14 | ; ECXX is in format: ien;test^source
|
|---|
| 15 | ;
|
|---|
| 16 | N ECX,ECXDA,ECXX,DA,DIC,DINUM,DIE,DR,X,Y,TEST,SOURCE,CNT
|
|---|
| 17 | D MES^XPDUTL(" ")
|
|---|
| 18 | D MES^XPDUTL(">>> Adding entries to DSS LAB TESTS File (#727.2)...")
|
|---|
| 19 | D MES^XPDUTL(" ")
|
|---|
| 20 | S $P(^DD(727.21,.01,0),U,5)="",CNT=0
|
|---|
| 21 | F ECX=1:1 S ECXX=$P($T(NEW7272+ECX),";;",2) Q:ECXX="QUIT" D
|
|---|
| 22 | .S ECXDA=$P(ECXX,";",1),ECXX=$P(ECXX,";",2)
|
|---|
| 23 | .Q:'$D(^ECX(727.2,1))
|
|---|
| 24 | .I $D(^ECX(727.2,1,1,0)),'$D(^ECX(727.2,1,1,ECXDA,0)) D
|
|---|
| 25 | ..S CNT=CNT+1
|
|---|
| 26 | ..S TEST=$P(ECXX,U,1),SOURCE=$P(ECXX,U,2)
|
|---|
| 27 | ..S DA(1)=1,DIC("P")=$P(^DD(727.2,1,0),U,2),DINUM=ECXDA
|
|---|
| 28 | ..S X=TEST,DIC="^ECX(727.2,1,1,",DLAYGO=727.21,DIC(0)="LX",DIC("DR")="2///^S X=SOURCE"
|
|---|
| 29 | ..K DD,DO D FILE^DICN K DLAYGO
|
|---|
| 30 | ..D MES^XPDUTL(" ")
|
|---|
| 31 | ..D MES^XPDUTL(">>>...."_TEST_" added to file as entry #"_ECXDA_".")
|
|---|
| 32 | ..D MES^XPDUTL(" ")
|
|---|
| 33 | I CNT=0 D
|
|---|
| 34 | .D MES^XPDUTL(">>>....Entries already exist -- nothing added.")
|
|---|
| 35 | .D MES^XPDUTL(" ")
|
|---|
| 36 | S $P(^DD(727.21,.01,0),U,5)="K X"
|
|---|
| 37 | Q
|
|---|
| 38 | ;
|
|---|
| 39 | NEW7272 ;- New records for file #727.2
|
|---|
| 40 | ;;51;PARTIAL THROMBOPLASTIN TIME (PTT)^B
|
|---|
| 41 | ;;52;INR (INTERNATIONAL NORMALIZED RATIO)^B
|
|---|
| 42 | ;;53;VITAMIN B6^B
|
|---|
| 43 | ;;54;HOMOCYSTEINE^B
|
|---|
| 44 | ;;55;OCCULT BLOOD (FECAL)^B
|
|---|
| 45 | ;;56;MICROALBUMIN/CREATININE RATIO^U
|
|---|
| 46 | ;;QUIT
|
|---|
| 47 | ;
|
|---|
| 48 | ;
|
|---|
| 49 | POST1 ;- Add new entry to file 728.441
|
|---|
| 50 | ; ECXREC is in format: code^short description
|
|---|
| 51 | ;
|
|---|
| 52 | ;
|
|---|
| 53 | N ECXFDA,ECXERR,ECXCODE,ECXREC,I
|
|---|
| 54 | D BMES^XPDUTL(">>> Adding entry to the NATIONAL CLINIC (#728.441) file...")
|
|---|
| 55 | ;
|
|---|
| 56 | ;- Get NATIONAL CLINIC record
|
|---|
| 57 | F I=1:1 S ECXREC=$P($T(NATCLIN+I),";;",2) Q:ECXREC="QUIT" D
|
|---|
| 58 | .;
|
|---|
| 59 | .;- National Clinic code
|
|---|
| 60 | .S ECXCODE=$P(ECXREC,"^")
|
|---|
| 61 | .;
|
|---|
| 62 | .;- Quit w/error message if entry already exists in file #728.441
|
|---|
| 63 | .I $$FIND1^DIC(728.441,"","X",ECXCODE) D Q
|
|---|
| 64 | ..D BMES^XPDUTL(">>>...."_ECXCODE_" "_$P(ECXREC,U,2)_" not added, entry already exists.")
|
|---|
| 65 | ..D BMES^XPDUTL(">>> Delete entries and reinstall patch if entries were not created by a")
|
|---|
| 66 | ..D MES^XPDUTL(">>> previous installation of this patch.")
|
|---|
| 67 | .;
|
|---|
| 68 | .;- Setup field values of new entry
|
|---|
| 69 | .S ECXFDA(728.441,"+1,",.01)=ECXCODE
|
|---|
| 70 | .S ECXFDA(728.441,"+1,",1)=$P(ECXREC,"^",2)
|
|---|
| 71 | .;
|
|---|
| 72 | .;- Add new entry to file #728.441
|
|---|
| 73 | .D UPDATE^DIE("E","ECXFDA","","ECXERR")
|
|---|
| 74 | .;
|
|---|
| 75 | .I '$D(ECXERR) D BMES^XPDUTL(">>>...."_ECXCODE_" "_$P(ECXREC,U,2)_" added to file.")
|
|---|
| 76 | .I $D(ECXERR) D BMES^XPDUTL(">>>....Unable to add "_ECXCODE_" "_$P(ECXREC,U,2)_" to file.")
|
|---|
| 77 | ;
|
|---|
| 78 | Q
|
|---|
| 79 | ;
|
|---|
| 80 | NATCLIN ;- Contains the NATIONAL CLINIC entry to be added
|
|---|
| 81 | ;;CLNS^Clinical Nurse Specialist
|
|---|
| 82 | ;;QUIT
|
|---|
