source: FOIAVistA/trunk/r/MEDICINE-MC/MCARPROC.m@ 1806

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

initial load of FOIAVistA 6/30/08 version

File size: 1.7 KB
Line 
1MCARPROC ;WISC/TJK,RCH-STORE PROCEDURES IN MEDICINE PATIENT FILE ;7/30/96 13:48
2 ;;2.3;Medicine;;09/13/1996
3INIT ;INITIALIZE VARIABLES
4 K XX S MCARCDIE=MCARCDIE_DA_",0)" I $P($G(@MCARCDIE),U,1)="" K MCARCDIE Q
5 S XX=$P(@MCARCDIE,U,1),CD=$P(@MCARCDIE,U,2) I CD="" K MCARCDIE,CD,XX
6 Q
7CHGDTE ;CHANGE PROCEDURE DATE
8 Q:'$D(MCARCDIE) D INIT G END:'$D(CD) S MCAROLDT=X G OLDAC
9CHGDTE1 ;SET "AC" CROSS-REFERENCE WITH NEW DATE
10 Q:'$D(MCARCDIE) D INIT G END:'$D(CD) S XX=X G CONT1
11CHGPAT ;TRANSFER PROCEDURE FROM ONE PATIENT TO ANOTHER
12 Q:'$D(MCARCDIE) D INIT G END:'$D(XX),CONT
13OLDAC K ^MCAR(690,"AC",CD,9999999.9999-MCAROLDT,$P($P(MCARCDIE,U,2),",",1),DA) Q
14CONT ;NEW PROCEDURE
15 S CD=X
16CONT1 ;STORE PROCEDURE IN "AC" CROSS REFERENCE OF MEDICINE PATIENT FILE
17 S ^MCAR(690,"AC",CD,9999999.9999-XX,$P($P(MCARCDIE,U,2),",",1),DA)=""
18END K MCARCDIE,CD,XX,MCAROLDT
19 Q
20KILL S CD=X,MCAROLDT=MCARCDIE_DA_",0)",MCAROLDT=$P(@MCAROLDT,U,1) D OLDAC K MCAROLDT,CD Q
21 Q
22MEDSET ;THIS SECTION SETS MEDICINE CODE AND CROSS-REFERENCE IN DRUG FILE
23 ;X-REF NO LONGER USED
24 Q S $P(^PSDRUG(DA,2),U,3)=$S('$D(^PSDRUG(DA,2)):"M",1:$P(^(2),U,3)_"M")
25 S ^PSDRUG("AIUM",$P(^PSDRUG(DA,0),U,1),DA)="" Q
26MEDKILL ;THIS SECTION DELETES MEDICINE CODE WHEN MEDICATION DELETED FROM MEDICATION FILE
27 ;X-REF NO LONGER USED
28 Q S MCARX=$P(^PSDRUG(DA,2),U,3),MCARY=$F(MCARX,"M"),MCARX=$E(MCARX,1,MCARY-2)_$E(MCARX,MCARY,9999)
29 S $P(^PSDRUG(DA,2),U,3)=MCARX K:^(2)?."^" ^(2)
30 K ^PSDRUG("AIUM",$P(^PSDRUG(DA,0),U,1),DA)
31 K MCARX,MCARY Q
32RBLD N CD,DA,II,XX
33 F II=691,691.1,691.5,691.6,691.7,691.8,694,698,698.1,698.2,698.3,699,700,701 D RBLD1
34 K II Q
35RBLD1 Q:'$D(^MCAR(II,"C")) F DA=0:0 S DA=$O(^MCAR(II,DA)) Q:DA'?1N.N S MCARCDIE="^MCAR("_II_"," D INIT I $D(MCARCDIE),$D(CD) D CONT1
36 Q
Note: See TracBrowser for help on using the repository browser.