MCARPROC ;WISC/TJK,RCH-STORE PROCEDURES IN MEDICINE PATIENT FILE ;7/30/96  13:48
 ;;2.3;Medicine;;09/13/1996
INIT ;INITIALIZE VARIABLES
 K XX S MCARCDIE=MCARCDIE_DA_",0)" I $P($G(@MCARCDIE),U,1)="" K MCARCDIE Q
 S XX=$P(@MCARCDIE,U,1),CD=$P(@MCARCDIE,U,2) I CD="" K MCARCDIE,CD,XX
 Q
CHGDTE ;CHANGE PROCEDURE DATE
 Q:'$D(MCARCDIE)  D INIT G END:'$D(CD) S MCAROLDT=X G OLDAC
CHGDTE1 ;SET "AC" CROSS-REFERENCE WITH NEW DATE
 Q:'$D(MCARCDIE)  D INIT G END:'$D(CD) S XX=X G CONT1
CHGPAT ;TRANSFER PROCEDURE FROM ONE PATIENT TO ANOTHER
 Q:'$D(MCARCDIE)  D INIT G END:'$D(XX),CONT
OLDAC K ^MCAR(690,"AC",CD,9999999.9999-MCAROLDT,$P($P(MCARCDIE,U,2),",",1),DA) Q
CONT ;NEW PROCEDURE
 S CD=X
CONT1 ;STORE PROCEDURE IN "AC" CROSS REFERENCE OF MEDICINE PATIENT FILE
 S ^MCAR(690,"AC",CD,9999999.9999-XX,$P($P(MCARCDIE,U,2),",",1),DA)=""
END K MCARCDIE,CD,XX,MCAROLDT
 Q
KILL S CD=X,MCAROLDT=MCARCDIE_DA_",0)",MCAROLDT=$P(@MCAROLDT,U,1) D OLDAC K MCAROLDT,CD Q
 Q
MEDSET ;THIS SECTION SETS MEDICINE CODE AND CROSS-REFERENCE IN DRUG FILE
 ;X-REF NO LONGER USED
 Q  S $P(^PSDRUG(DA,2),U,3)=$S('$D(^PSDRUG(DA,2)):"M",1:$P(^(2),U,3)_"M")
 S ^PSDRUG("AIUM",$P(^PSDRUG(DA,0),U,1),DA)="" Q
MEDKILL ;THIS SECTION DELETES MEDICINE CODE WHEN MEDICATION DELETED FROM MEDICATION FILE
 ;X-REF NO LONGER USED
 Q  S MCARX=$P(^PSDRUG(DA,2),U,3),MCARY=$F(MCARX,"M"),MCARX=$E(MCARX,1,MCARY-2)_$E(MCARX,MCARY,9999)
 S $P(^PSDRUG(DA,2),U,3)=MCARX K:^(2)?."^" ^(2)
 K ^PSDRUG("AIUM",$P(^PSDRUG(DA,0),U,1),DA)
 K MCARX,MCARY Q
RBLD N CD,DA,II,XX
 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
 K II Q
RBLD1 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
 Q