source: FOIAVistA/trunk/r/MEDICINE-MC/MCARAM5.m@ 811

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

initial load of FOIAVistA 6/30/08 version
File size: 4.3 KB
Line 
1MCARAM5 ;WASH ISC/JKL-MUSE TRANSFER LOCAL DATA INTO DHCP ;4/24/96 09:24
2 ;;2.3;Medicine;**31**;09/13/1996
3 ;
4 ;
5EKG(MCA,MCE) ;Transfer local array data into new EKG record in DHCP
6 ; USAGE: S X=$$EKG^MCARAM5(.A,.B)
7 ; WHERE: A=array of local data
8 ; B=array of DHCP data
9 ; including internal record number of EKG file
10 ; if successful, returns function value of 0
11 ; if unsuccessful, returns error message
12 ; check for valid SSN
13 N MCI,%,MCERR,Y,DIC,X,MCP
14 S MCERR=$$LSSN^MCARAM6(MCA("DT"),MCA(.02),.MCP)
15 I +MCERR'=55 S MCERR=$$NMCHK^MCARAM5(.MCA,.MCP) I +MCERR>50 Q MCERR
16 I +MCERR=55 S MCERR=$$LNAME^MCARAM6(MCA("DT"),MCA("NAME"),.MCP) Q:+MCERR>50 "55-Social Security Number not in Patient file" S MCERR=$$SSNCHK^MCARAM5(.MCA,.MCP) I +MCERR>50 Q MCERR
17 ; if PID not a medical patient, add PID to medical patient file
18 I '$D(^MCAR(690,MCP(1))) S ^MCAR(690,MCP(1),0)=MCP(1),^MCAR(690,"B",MCP(1),MCP(1))="",$P(^MCAR(690,0),U,4)=$P(^MCAR(690,0),U,4)+1 S:$P(^MCAR(690,0),U,3)<MCP(1) $P(^MCAR(690,0),U,3)=MCP(1)
19 ; set confirmation status, field 11,of record
20 S MCA(11)="C"
21 S MCI=.02,MCA(1)=MCP(1),DIC("DR")=".02///"_MCA(.02) F S MCI=$O(MCA(MCI)) Q:MCI=""!(MCI?1A.A) S DIC("DR")=DIC("DR")_";"_MCI_"///"_MCA(MCI)
22 ; EKG Data dictionary identified by PID of 690, PID of 690 .01 is file 2
23 S DIC("DR")=$P(DIC("DR"),"1///")_"1////"_$P(DIC("DR"),"1///",2,99)
24 K DD,DO N DLAYGO S DLAYGO=691.5,DIC="^MCAR(691.5,",DIC(0)="LXZ",X=MCA("DT")
25 D FILE^DICN
26 I +Y'>0 Q $$LOG^MCARAM7("58-ECG record not filed")
27 ; set automated instrument data, field 21,of record
28 S MCE("EKG")=+Y
29 D NOW^%DTC S ^MCAR(691.5,MCE("EKG"),"A")=%
30 Q 0
31 ;
32EKGDG(MCA,MCE) ; Transfer local array diagnosis data into EKG record
33 ; USAGE: S X=$$EKGDG^MCARAM5(.A,.B)
34 ; WHERE: A=array of diagnosis data
35 ; B=array of DHCP data
36 ; including internal record number of EKG file
37 ; if successful, returns function value of 0
38 ; if unsuccessful, returns error message
39 N MCI,MCJ
40 I '$D(^MCAR(691.5,MCE("EKG"))) Q $$LOG^MCARAM7("59-ECG record undefined-Diagnosis not filed")
41 S MCERR=$$DGCK^MCARAM4(.MCA) I +MCERR>50 Q $$LOG^MCARAM7(MCERR)
42 S MCI="DX,0"
43 F MCJ=1:1:MCA(MCI) S MCI=$O(MCA(MCI)),^MCAR(691.5,MCE("EKG"),9,MCJ,0)=MCA(MCI)
44 S ^MCAR(691.5,MCE("EKG"),9,0)=U_U_MCJ_U_MCJ
45 Q 0
46 ;
47EKGRX(MCA,MCE) ; Transfer local array medication data into EKG record
48 ; USAGE: S X=$$EKGDG^MCARAM5(.A,.B)
49 ; WHERE: A=array of medication data
50 ; B=array of DHCP data
51 ; including internal record number of EKG file
52 ; if successful, returns function value of 0
53 ; if unsuccessful, returns error message
54 N MCI
55 I '$D(^MCAR(691.5,MCE("EKG"))) Q $$LOG^MCARAM7("60-ECG record undefined-Medication not filed")
56 S ^MCAR(691.5,MCE("EKG"),2,0)="^691.53PA"
57 S MCERR=$$RXCK^MCARAM4(.MCA) I +MCERR>0 Q $$LOG^MCARAM7(MCERR)
58 S DIE="^MCAR(691.5,"_MCE("EKG")_",2,",DA(1)=MCE("EKG")
59 F MCI=1:1:MCA("RX,0") S DA=MCI,DR=".01///^S X=$P(MCA(""RX,""_MCI),U);1///^S X=$P(MCA(""RX,""_MCI),U,2);2///^S X=$P(MCA(""RX,""_MCI),U,3)" D ^DIE
60 S ^MCAR(691.5,MCE("EKG"),2,0)="^691.53PA^"_MCI_U_MCI
61 Q 0
62 ;
63EKGOR(MCA,MCE) ;Transfer order entry data into EKG record
64 ; USAGE: S X=$$EKGOR^MCARAM5(.A,.B)
65 ; WHERE: A=array of local data
66 ; including print name for ECG procedure/subspecialty
67 ; B=array of DHCP data
68 ; including internal record number of EKG file
69 ; if successful, returns function value of 0
70 ; if unsuccessful, returns error message
71 Q 0
72NMCHK(MCA,MCP) ;Check name input against patient data
73 ; Marquette allows 16 chars for last name and 10 chars for first etc.
74 ; USAGE: S X=$$NMCHK^MCARAM5(.MCA,.MCP)
75 ; WHERE: MCA=array of local data
76 ; MCP=array of DHCP patient data
77 ; if successful, returns function value of 0
78 ; if unsuccessful, returns error message
79 N MCI,MCERR S MCERR=0
80 S MCP("LNAME")=$P(MCP("NAME"),","),MCA("LNAME")=$P(MCA("NAME"),",")
81 F MCI=1:1:$L(MCP("LNAME")) Q:$L(MCP("LNAME"))>16 I $E(MCA("LNAME"),MCI,MCI)'=$E(MCP("LNAME"),MCI,MCI) S MCERR="56-Name does not match Patient file" Q
82 Q MCERR
83 ;
84SSNCHK(MCA,MCP) ;Check SSN input
85 ; USAGE: S X=$$SSNCHK^MCARAM5(.MCA,.MCP)
86 ; WHERE: MCA=array of local data
87 ; MCP=array of DHCP patient data
88 ; if successful, returns function value of 0
89 ; if unsuccessful, returns error message
90 N MCI,MCERR S MCERR=0
91 S MCP("SSN")=$P(^DPT(MCP(1),0),"^",9)
92 I $E(MCA(.02),1,8)'=$E(MCP("SSN"),1,8) S MCERR="55-Social Security Number not in Patient file"
93 Q MCERR
Note: See TracBrowser for help on using the repository browser.