| [613] | 1 | MCARAM5 ;WASH ISC/JKL-MUSE TRANSFER LOCAL DATA INTO DHCP ;4/24/96 09:24
|
|---|
| 2 | ;;2.3;Medicine;**31**;09/13/1996
|
|---|
| 3 | ;
|
|---|
| 4 | ;
|
|---|
| 5 | EKG(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 | ;
|
|---|
| 32 | EKGDG(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 | ;
|
|---|
| 47 | EKGRX(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 | ;
|
|---|
| 63 | EKGOR(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
|
|---|
| 72 | NMCHK(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 | ;
|
|---|
| 84 | SSNCHK(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
|
|---|
