Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: MCARPROC

MCARPROC.m

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