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

SRTPUTL.m

Go to the documentation of this file.
  1. SRTPUTL ;BIR/SJA - UTILITY ROUTINE ;08/11/2011
  1. ;;3.0;Surgery;**167,175,176**;24 Jun 93;Build 8
  1. ;
  1. ; Reference to EN1^GMRVUT0 supported by DBIA #1446
  1. ;
  1. ADT ; set 'ADT x-ref
  1. S SRINVDT=9999999-X S ^SRT("ADT",$P(^SRT(DA,0),"^"),SRINVDT,DA)=X K SRINVDT
  1. Q
  1. KADT ; kill 'ADT' x-ref
  1. S SRINVDT=9999999-X K ^SRT("ADT",$P(^SRT(DA,0),"^"),SRINVDT,DA),SRINVDT
  1. Q
  1. AT ; set logic for AT x-ref on DATE OF LAST TRANSMISSION
  1. N SRX S ^SRT("AT",X,DA)=""
  1. S SRX=$P($G(^SRT(DA,"RA")),"^",4) I SRX,SRX'=X K ^SRT("AT",SRX,DA)
  1. Q
  1. KAT ; kill logic for AT x-ref on DATE OF LAST TRANSMISSION
  1. N SRX K ^SRT("AT",X,DA)
  1. S SRX=$P($G(^SRT(DA,"RA")),"^",4) I SRX,SRX'=X K ^SRT("AT",SRX,DA)
  1. Q
  1. AGE ; set logic of the 'AGE' x-ref on the Donor's Date of Birth
  1. N DOB,DOT
  1. S SRTPP=$S($D(SRTPP):SRTPP,1:DA)
  1. S DOB=$P($G(^SRT(SRTPP,1)),"^"),DOT=$P($G(^SRT(SRTPP,0)),"^",2)
  1. I DOB&DOT S $P(^SRT(SRTPP,1),"^",6)=(($$FMDIFF^XLFDT(DOT,DOB))\365.25)
  1. Q
  1. KAGE ; 'KILL' logic of the 'AGE' x-ref on the Date of Birth
  1. S SRTPP=$S($D(SRTPP):SRTPP,1:DA),$P(^SRT(SRTPP,1),"^",6)=""
  1. Q
  1. Y Q:'$D(X) I X'?.N1"Y"&(X'?.N1"y"),(+X'=X) K X Q
  1. S:X["y" X=+X_"Y"
  1. Q
  1. HLA ; called by input transform of the HLA TYPING fields
  1. N SRX S SRX=X K:'(X?.4N.3(1","1.4N)) X S:SRX="NS"!(SRX="ns") X="NS"
  1. Q
  1. PVR ; called by input transform of the PVR VASODILATION fields
  1. N SRX,SRY S SRX=X K:+X'=X!(X>9.9)!(X<0)!(X?.E1"."2.N) X S:SRX="NS"!(SRX="ns") X="NS"
  1. I +DR=163,$P($G(^SRT(SRTPP,.01)),"^",6)="NS" S SRY=1
  1. I +DR=164,$P($G(^SRT(SRTPP,.01)),"^",5)="NS" S SRY=1
  1. I $G(SRY)=1,SRX="NS" D EN^DDIOL("'NS' is only allowed in one of the PVR fields!",,"!,?2") K X D RET^SRTPCOM Q
  1. Q
  1. CHK199 ; check entries of the Tobacco Use Timeframe field (#199) based on the value of the Tobacco Use field.
  1. S DA=$S($G(SRTPP):SRTPP,1:DA)
  1. I "123"[X,($P($G(^SRT(DA,.55)),"^",24)<3) D EN^DDIOL("Invalid entry as the TOBACCO USE value is less than three.","","!?2,$C(7)") K X Q
  1. I X="NA",($P($G(^SRT(DA,.55)),"^",24)>2) D EN^DDIOL("Invalid entry as the TOBACCO USE value is greater than two.","","!?2,$C(7)") K X Q
  1. Q
  1. TUT ; set default value for tobacco use timeframe
  1. S X=$G(^SRT(SRTPP,.55)) I $P(X,"^",24)="",$P(X,"^",25)="" S $P(^SRT(SRTPP,.55),"^",25)="NA"
  1. Q
  1. HW ; get weight & height from Vitals
  1. N SREND,SREQ,SREX,SREY,SRSTRT
  1. WT I $P($G(^SRT(SRTPP,0)),"^",5)="" D
  1. .S SREND=$P($G(^SRT(SRTPP,0)),"^",2),SRSTRT=$$FMADD^XLFDT(SREND,-30),SREX=$$HW^SROACL1(SRSTRT,SREND,"WT")
  1. .I SREX'="" S SREX=SREX+.5\1 D CHK^DIE(139.5,5,"E",SREX,.SREY) I SREY'="^" S $P(^SRT(SRTPP,0),"^",5)=SREY
  1. HT I $P($G(^SRT(SRTPP,0)),"^",4)'="" Q
  1. N GMRVSTR,SRBRDT,SRBIEN,SRBDATA,SRHTDT
  1. K ^UTILITY($J,"GMRVD"),RESULTS S SREND=$P($G(^SRT(SRTPP,0)),"^",2),GMRVSTR="HT",GMRVSTR(0)="^"_SREND_"^^0"
  1. D EN1^GMRVUT0 Q:'$D(^UTILITY($J,"GMRVD"))
  1. S SRBRDT="",SRBRDT=$O(^UTILITY($J,"GMRVD","HT",SRBRDT)) Q:'SRBRDT D
  1. .S SRBIEN=0 F S SRBIEN=$O(^UTILITY($J,"GMRVD","HT",SRBRDT,SRBIEN)) Q:'SRBIEN D
  1. ..S SRBDATA=$G(^UTILITY($J,"GMRVD","HT",SRBRDT,SRBIEN)),SREX=$P(SRBDATA,"^",8)
  1. ..I SREX'="" S SREX=SREX+.5\1 D CHK^DIE(139.5,4,"E",SREX,.SREY) I SREY'="^" D
  1. ...S $P(^SRT(SRTPP,0),"^",4)=SREY
  1. Q
  1. F69(SRTPP) ; restrict selection of DCD & SCD for heart transplant
  1. N SROK S SROK=1
  1. I $P($G(^SRT(SRTPP,"RA")),"^",2)="H" I Y=2!(Y=4) S SROK=0
  1. Q SROK
  1. F147(SRTPP) ; screen out DIET for Lung, Liver, and Kidney
  1. N SROK S SROK=1
  1. I $P($G(^SRT(SRTPP,"RA")),"^",2)]"",$P($G(^SRT(SRTPP,"RA")),"^",2)'="H" I Y="D" S SROK=0
  1. Q SROK
  1. HDR ; print screen header
  1. W @IOF,!,SRHDR W:$G(SRPAGE)'="" ?(79-$L(SRPAGE)),SRPAGE
  1. S I=0 F S I=$O(SRHDR(I)) Q:'I W !,SRHDR(I) I I=1,$L($G(SRHPG)) W ?(79-$L(SRHPG)),SRHPG
  1. K SRHPG,SRPAGE W ! F I=1:1:80 W "-"
  1. W !
  1. Q
  1. SRHDR N X,I K SRHDR S DFN=$P(^SRT(SRTPP,0),"^"),SRCASE=$P(^SRT(SRTPP,0),"^",3),SRVACO=$P($G(^SRT(SRTPP,.01)),"^",11) D DEM^VADPT
  1. S SRHDR=VADM(1)_" ("_$P(VA("PID"),"-",3)_") VACO ID: "_SRVACO_$S('SRNOVA:" CASE: "_SRCASE,1:"")
  1. S Y=$P(^SRT(SRTPP,0),"^",2) X ^DD("DD") S SRSDATE=Y
  1. S I=$P($G(^SRT(SRTPP,"RA")),"^",2),SROPER=$$TR(I)_" TRANSPLANT"
  1. S SROPER=SROPER S SRHDR(1)=SRSDATE_" "_SROPER
  1. Q
  1. TR(SRI) ;
  1. Q $S(SRI="K":"KIDNEY",SRI="LI":"LIVER",SRI="LU":"LUNG",SRI="H":"HEART",1:"")