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

VBECDCM2.m

Go to the documentation of this file.
  1. VBECDCM2 ;hoifo/gjc-VBECS MAPPING TABLE add, edit & delete utilities;Nov 21, 2002
  1. ;;2.0;VBEC;;Jun 05, 2015;Build 4
  1. ;
  1. ;Medical Device #:
  1. ;Note: The food and Drug Administration classifies this software as a
  1. ;medical device. As such, it may not be changed in any way.
  1. ;Modifications to this software may result in an adulterated medical
  1. ;device under 21CFR820, the use of which is considered to be a
  1. ;violation of US Federal Statutes. Acquiring and implementing this
  1. ;software through the Freedom of Information Act requires the
  1. ;implementer to assume total responsibility for the software, and
  1. ;become a registered manufacturer of a medical device, subject to FDA
  1. ;regulations.
  1. ;
  1. ;Call to $$NEWERR^%ZTER is supported by IA: 1621
  1. ;Call to FILE^DIE is supported by IA: 2053
  1. ;Call to UPDATE^DIE is supported by IA: 2053
  1. ;Call to ^DIK is supported by IA: 10013
  1. ;Call to $$ROOT^DILFD is supported by IA: 2055
  1. ;Call to $$NOW^XLFDT is supported by IA: 10103
  1. ;Execution of ^%ZOSF("TEST") is supported by IA: 10096
  1. ;
  1. EN654 ; handle transfusion reactions.
  1. I $$NEWERR^%ZTER N $ETRAP,$ESTACK S $ETRAP="D ERR^VBECDCU1"
  1. E S X="D ERR^VBECDCU1",@^%ZOSF("TRAP")
  1. ;
  1. ;initially add trans. reactions to file 6005
  1. ;
  1. I +$O(^VBEC(6005,"AA","65.4-"))'=65.4 D
  1. .Q:'$$LOCK^VBECDCU2(65.4)
  1. .W !!,"Adding site configured 'Transfusion Reaction' information into the VBECS MAPPING",!,"TABLE file (#6005)."
  1. .S (CNT,VBECY)=0
  1. .F S VBECY=$O(^LAB(65.4,VBECY)) Q:'VBECY D ;trans. react.
  1. ..S VBECY(0)=$G(^LAB(65.4,VBECY,0)) Q:$P(VBECY(0),U,2)'="T"
  1. ..S CNT=CNT+1 D POP6005(65.4,VBECY,$P(VBECY(0),U),$P(VBECY(0),U,3))
  1. ..W:'(CNT#100) "."
  1. ..Q
  1. .D UNLOCK^VBECDCU2(65.4)
  1. .Q
  1. S:+$O(^VBEC(6005,"AA","65.4-"))=65.4 VBECFLG=1
  1. I W !!,CNT_" transfusion record"_$S(CNT=1:"",1:"s")_" added.",!
  1. ;
  1. ;handle transfusion reaction edit, and add events here
  1. ;
  1. E D
  1. .S VBECFLG=0 Q:'$$LOCK^VBECDCU2(65.4) ;RLM 10/27/05
  1. .S VBECY=0 F S VBECY=$O(^LAB(65.4,VBECY)) Q:'VBECY D
  1. ..S VBECY(0)=$G(^LAB(65.4,VBECY,0)),VBEC01=65.4_"-"_VBECY
  1. ..S VBECIEN=+$O(^VBEC(6005,"B",VBEC01,0)),VBECIEN(0)=$G(^VBEC(6005,VBECIEN,0))
  1. ..;
  1. ..;if transfusion reaction not filed in 6005, add it
  1. ..I 'VBECIEN,($P(VBECY(0),U,2)="T") S VBECFLG=1 D POP6005(65.4,VBECY,$P(VBECY(0),U),$P(VBECY(0),U,3)) ;if added, no need to perform edit check
  1. ..Q:'VBECIEN
  1. ..;
  1. ..;check if the name or identifier attribute has been edited
  1. ..;if parent record changes from TRANSFUSION REACTION delete from 6005
  1. ..I $P(VBECY(0),U,2)'="T" D Q
  1. ...K DA,DIK S DA=VBECIEN,DIK="^VBEC(6005,",VBECFLG=1 D ^DIK
  1. ...K %,DA,DIC,DIK,X,Y
  1. ...Q
  1. ..S VBECTOT=0,VBECTOT=$$CHECKSUM^VBECDCU2($P(VBECY(0),U))
  1. ..S VBECTOT=VBECTOT+$$CHECKSUM^VBECDCU2($P(VBECY(0),U,3))
  1. ..I VBECTOT'=$P(VBECIEN(0),U,6) D S VBECFLG=1 K VBECTOT
  1. ...S:$P(VBECY(0),U)'=$P(VBECIEN(0),U,2) VBECFDA(6005,VBECIEN_",",.02)=$P(VBECY(0),U)
  1. ...S:$P(VBECY(0),U,3)'=$P(VBECIEN(0),U,3) VBECFDA(6005,VBECIEN_",",.03)=$P(VBECY(0),U,3)
  1. ...S VBECFDA(6005,VBECIEN_",",.05)="@"
  1. ...S VBECFDA(6005,VBECIEN_",",.06)=VBECTOT
  1. ...S VBECFDA(6005,VBECIEN_",",.07)=+$E($$NOW^XLFDT(),1,12)
  1. ...D FILE^DIE("","VBECFDA")
  1. ...Q
  1. ..Q
  1. .D UNLOCK^VBECDCU2(65.4)
  1. .Q
  1. ; handle delete transaction reaction actions here
  1. D DELETE(65.4)
  1. I $G(VBECFLG) W !!,"Transfusion Reaction information updated.",! ;RLM 10/27/05
  1. E W !!,"Transfusion Reaction information current, not updated.",!
  1. D XIT
  1. Q
  1. ;
  1. XIT ; unlock, kill, and quit
  1. L -^VBEC(6005)
  1. K CNT,DIR,DIRUT,DTOUT,DUOUT,VBEC01,VBECANTI,VBECFLD,VBECFLE,VBECFLG,VBECHLP,VBECIEN,VBECRT,VBECTMP,VBECXIT,VBECX,VBECY,VBECYN,X,Y
  1. K ^TMP($J,"VBEC SUPPLIER")
  1. Q
  1. ;
  1. POP6005(VBECFILE,VBECIEN,VBEC01,VBECID,VBECANTI) ; Populate the
  1. ; VBECS MAPPING TABLE file (#6005) with antigen/antibody & blood
  1. ; transfusion reaction data.
  1. ; Input: VBECFILE=VistA file referenced (required)
  1. ; VBECIEN=VistA internal entry number referenced
  1. ; VBEC01=value of the .01 field (required, external)
  1. ; VBECID=file identifier
  1. ; VBECANTI=antibody/antigen identifier
  1. ;
  1. S VBECTOT=0,VBECTOT=$$CHECKSUM^VBECDCU2(VBEC01)
  1. S VBECTOT=VBECTOT+$$CHECKSUM^VBECDCU2(VBECID)
  1. S:$G(VBECANTI)'="" VBECTOT=VBECTOT+$$CHECKSUM^VBECDCU2(VBECANTI)
  1. F S COUNT=(+$O(^VBEC(6005,$C(32)),-1)+1) Q:'($D(^VBEC(6005,COUNT,0))#2)
  1. S VBECFDA(6005,"+"_COUNT_",",.01)=VBECFILE_"-"_VBECIEN
  1. S VBECFDA(6005,"+"_COUNT_",",.02)=VBEC01
  1. S:$G(VBECID)'="" VBECFDA(6005,"+"_COUNT_",",.03)=VBECID
  1. S:$G(VBECANTI)'="" VBECFDA(6005,"+"_COUNT_",",.04)=VBECANTI
  1. S VBECFDA(6005,"+"_COUNT_",",.06)=VBECTOT
  1. S VBECFDA(6005,"+"_COUNT_",",.07)=+$E($$NOW^XLFDT(),1,12)
  1. D UPDATE^DIE("E","VBECFDA") K COUNT,VBECFDA,VBECTOT
  1. Q
  1. ;
  1. DELETE(VBECFN) ; delete individual record from file 6005 that no longer exist
  1. ; in their parent files.
  1. ;Input: VBECFN=the file number of the parent file
  1. ;return: VBECFLG=indicates if updates (deletions) to file 6005 occurred
  1. N VBEC6005,VBECIEN,VBECRT,VBECX K %,DA,DIC,DIK,X,Y
  1. S VBECX=VBECFN_"-",VBECRT=$$ROOT^DILFD(VBECFN,"",1)
  1. F S VBECX=$O(^VBEC(6005,"B",VBECX)) Q:VBECX=""!(+VBECX'=VBECFN) D
  1. .S VBEC6005=$O(^VBEC(6005,"B",VBECX,0)) Q:VBEC6005=0
  1. .S VBECIEN=+$P(VBECX,"-",2)
  1. .I $D(@VBECRT@(VBECIEN,0))#2 Q ;data resides in the parent file
  1. .S DIK="^VBEC(6005,",DA=VBEC6005,VBECFLG=1 D ^DIK K %,DA,DIC,DIK,X,Y
  1. Q
  1. ;