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