SCDXUTL2 ;ALB/MTC/JLU - PRINT UTILITY ROUTINES;23-MAY-1996 ; 20 Nov 98 12:25 AM
;;5.3;Scheduling;**44,66,154**;AUG 13, 1993
;
PAT(D0) ;-- This function is used for the computed field 20.01 in file
; Transmission OutPatient Encounter file 409.73. For the given
; entry in 409.73 a determination of the PATIENT involved with
; the transaction will be determined.
;
N SDTOE
S SDTOE=$G(^SD(409.73,D0,0))
I $P(SDTOE,U,2)="",$P(SDTOE,U,3) D
. S X=$P($G(^SD(409.74,$P(SDTOE,U,3),0)),U,2)
E I $P(SDTOE,U,2),$P(SDTOE,U,3)="" D
. S X=$P($G(^SCE($P(SDTOE,U,2),0)),U,2)
E S X=""
I X S X=$P($G(^DPT(X,0)),U)
Q
;
SSN(D0) ;-- This function is used for the computed field 20.04 in file
; Transmission OutPatient Encounter file 409.73. For the given
; entry in 409.73 a determination of the PATIENT SSN involved with
; the transaction will be determined.
;
N SDTOE
S SDTOE=$G(^SD(409.73,D0,0))
I $P(SDTOE,U,2)="",$P(SDTOE,U,3) D
. S X=$P($G(^SD(409.74,$P(SDTOE,U,3),0)),U,2)
E I $P(SDTOE,U,2),$P(SDTOE,U,3)="" D
. S X=$P($G(^SCE($P(SDTOE,U,2),0)),U,2)
E S X=""
I X S X=$P($G(^DPT(X,0)),U,9)
Q
;
PATDFN(D0) ; This call will return the patient's DFN. It is identical to
;the PAT call above. The only difference is that it leaves DFN defined
;to the patient's DFN.
;
N SDTOE
S SDTOE=$G(^SD(409.73,D0,0))
I $P(SDTOE,U,2)="",$P(SDTOE,U,3) D
. S DFN=$P($G(^SD(409.74,$P(SDTOE,U,3),0)),U,2)
E I $P(SDTOE,U,2),$P(SDTOE,U,3)="" D
. S DFN=$P($G(^SCE($P(SDTOE,U,2),0)),U,2)
E S DFN=""
Q
;
ECDT(D0) ;-- This function is used for the computed field 20.02 in file
; Transmission OutPatient Encounter file 409.73. For the given
; entry in 409.73 a determination of the ENCOUNTER D/T involved with
; the transaction will be determined.
;
N SDTOE
S SDTOE=$G(^SD(409.73,D0,0))
I $P(SDTOE,U,2)="",$P(SDTOE,U,3) D
. S X=$P($G(^SD(409.74,$P(SDTOE,U,3),0)),U)
E I $P(SDTOE,U,2),$P(SDTOE,U,3)="" D
. S X=$P($G(^SCE($P(SDTOE,U,2),0)),U)
E S X=""
I X S Y=X D DD^%DT S X=$TR(Y,"@"," ")
Q
;
EDIV(D0,INT) ;-- This function is used for the computed fields 20.05 and 20.06
; in the Transmission OutPatient Encounter file 409.73. For the
; given entry in 409.73 a determination of the ENCOUNTER DIVISION
; involved with the transaction will be determined.
;
; Optional input: INT='1' to return internal (ifn) value
;
N SDTOE
S SDTOE=$G(^SD(409.73,D0,0))
I $P(SDTOE,U,2)="",$P(SDTOE,U,3) D
. S X=$P($G(^SD(409.74,$P(SDTOE,U,3),1)),U,11)
E I $P(SDTOE,U,2),$P(SDTOE,U,3)="" D
. S X=$P($G(^SCE($P(SDTOE,U,2),0)),U,11)
E S X=""
I '$G(INT),X S X=$P($G(^DG(40.8,+X,0)),U)
Q
;
ECLOC(D0) ;-- This function is used for the computed field 20.03 in file
; Transmission OutPatient Encounter file 409.73. For the given
; entry in 409.73 a determination of the LOCATION involved with
; the transaction will be determined.
;
N SDTOE
S SDTOE=$G(^SD(409.73,D0,0))
I $P(SDTOE,U,2)="",$P(SDTOE,U,3) D
. S X=$P($G(^SD(409.74,$P(SDTOE,U,3),1)),U,4)
E I $P(SDTOE,U,2),$P(SDTOE,U,3)="" D
. S X=$P($G(^SCE($P(SDTOE,U,2),0)),U,4)
E S X=""
I X S X=$P($G(^SC(X,0)),U)
Q
;
XDATE(D0) ;-- This function is used for the computed field 10.01 in file
; Transmitted OutPatinet Encounter Error file 409.75. For the given
; entry the x-mit date to NPCDB will be determined.
N SDXDT
S X=""
S SDXDT=$P($G(^SD(409.73,+$P($G(^SD(409.75,D0,0)),U),1)),U)
I SDXDT S Y=SDXDT X ^DD("DD") S X=$TR(Y,"@"," ")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCDXUTL2 3555 printed Oct 16, 2024@18:40:17 Page 2
SCDXUTL2 ;ALB/MTC/JLU - PRINT UTILITY ROUTINES;23-MAY-1996 ; 20 Nov 98 12:25 AM
+1 ;;5.3;Scheduling;**44,66,154**;AUG 13, 1993
+2 ;
PAT(D0) ;-- This function is used for the computed field 20.01 in file
+1 ; Transmission OutPatient Encounter file 409.73. For the given
+2 ; entry in 409.73 a determination of the PATIENT involved with
+3 ; the transaction will be determined.
+4 ;
+5 NEW SDTOE
+6 SET SDTOE=$GET(^SD(409.73,D0,0))
+7 IF $PIECE(SDTOE,U,2)=""
IF $PIECE(SDTOE,U,3)
Begin DoDot:1
+8 SET X=$PIECE($GET(^SD(409.74,$PIECE(SDTOE,U,3),0)),U,2)
End DoDot:1
+9 IF '$TEST
IF $PIECE(SDTOE,U,2)
IF $PIECE(SDTOE,U,3)=""
Begin DoDot:1
+10 SET X=$PIECE($GET(^SCE($PIECE(SDTOE,U,2),0)),U,2)
End DoDot:1
+11 IF '$TEST
SET X=""
+12 IF X
SET X=$PIECE($GET(^DPT(X,0)),U)
+13 QUIT
+14 ;
SSN(D0) ;-- This function is used for the computed field 20.04 in file
+1 ; Transmission OutPatient Encounter file 409.73. For the given
+2 ; entry in 409.73 a determination of the PATIENT SSN involved with
+3 ; the transaction will be determined.
+4 ;
+5 NEW SDTOE
+6 SET SDTOE=$GET(^SD(409.73,D0,0))
+7 IF $PIECE(SDTOE,U,2)=""
IF $PIECE(SDTOE,U,3)
Begin DoDot:1
+8 SET X=$PIECE($GET(^SD(409.74,$PIECE(SDTOE,U,3),0)),U,2)
End DoDot:1
+9 IF '$TEST
IF $PIECE(SDTOE,U,2)
IF $PIECE(SDTOE,U,3)=""
Begin DoDot:1
+10 SET X=$PIECE($GET(^SCE($PIECE(SDTOE,U,2),0)),U,2)
End DoDot:1
+11 IF '$TEST
SET X=""
+12 IF X
SET X=$PIECE($GET(^DPT(X,0)),U,9)
+13 QUIT
+14 ;
PATDFN(D0) ; This call will return the patient's DFN. It is identical to
+1 ;the PAT call above. The only difference is that it leaves DFN defined
+2 ;to the patient's DFN.
+3 ;
+4 NEW SDTOE
+5 SET SDTOE=$GET(^SD(409.73,D0,0))
+6 IF $PIECE(SDTOE,U,2)=""
IF $PIECE(SDTOE,U,3)
Begin DoDot:1
+7 SET DFN=$PIECE($GET(^SD(409.74,$PIECE(SDTOE,U,3),0)),U,2)
End DoDot:1
+8 IF '$TEST
IF $PIECE(SDTOE,U,2)
IF $PIECE(SDTOE,U,3)=""
Begin DoDot:1
+9 SET DFN=$PIECE($GET(^SCE($PIECE(SDTOE,U,2),0)),U,2)
End DoDot:1
+10 IF '$TEST
SET DFN=""
+11 QUIT
+12 ;
ECDT(D0) ;-- This function is used for the computed field 20.02 in file
+1 ; Transmission OutPatient Encounter file 409.73. For the given
+2 ; entry in 409.73 a determination of the ENCOUNTER D/T involved with
+3 ; the transaction will be determined.
+4 ;
+5 NEW SDTOE
+6 SET SDTOE=$GET(^SD(409.73,D0,0))
+7 IF $PIECE(SDTOE,U,2)=""
IF $PIECE(SDTOE,U,3)
Begin DoDot:1
+8 SET X=$PIECE($GET(^SD(409.74,$PIECE(SDTOE,U,3),0)),U)
End DoDot:1
+9 IF '$TEST
IF $PIECE(SDTOE,U,2)
IF $PIECE(SDTOE,U,3)=""
Begin DoDot:1
+10 SET X=$PIECE($GET(^SCE($PIECE(SDTOE,U,2),0)),U)
End DoDot:1
+11 IF '$TEST
SET X=""
+12 IF X
SET Y=X
DO DD^%DT
SET X=$TRANSLATE(Y,"@"," ")
+13 QUIT
+14 ;
EDIV(D0,INT) ;-- This function is used for the computed fields 20.05 and 20.06
+1 ; in the Transmission OutPatient Encounter file 409.73. For the
+2 ; given entry in 409.73 a determination of the ENCOUNTER DIVISION
+3 ; involved with the transaction will be determined.
+4 ;
+5 ; Optional input: INT='1' to return internal (ifn) value
+6 ;
+7 NEW SDTOE
+8 SET SDTOE=$GET(^SD(409.73,D0,0))
+9 IF $PIECE(SDTOE,U,2)=""
IF $PIECE(SDTOE,U,3)
Begin DoDot:1
+10 SET X=$PIECE($GET(^SD(409.74,$PIECE(SDTOE,U,3),1)),U,11)
End DoDot:1
+11 IF '$TEST
IF $PIECE(SDTOE,U,2)
IF $PIECE(SDTOE,U,3)=""
Begin DoDot:1
+12 SET X=$PIECE($GET(^SCE($PIECE(SDTOE,U,2),0)),U,11)
End DoDot:1
+13 IF '$TEST
SET X=""
+14 IF '$GET(INT)
IF X
SET X=$PIECE($GET(^DG(40.8,+X,0)),U)
+15 QUIT
+16 ;
ECLOC(D0) ;-- This function is used for the computed field 20.03 in file
+1 ; Transmission OutPatient Encounter file 409.73. For the given
+2 ; entry in 409.73 a determination of the LOCATION involved with
+3 ; the transaction will be determined.
+4 ;
+5 NEW SDTOE
+6 SET SDTOE=$GET(^SD(409.73,D0,0))
+7 IF $PIECE(SDTOE,U,2)=""
IF $PIECE(SDTOE,U,3)
Begin DoDot:1
+8 SET X=$PIECE($GET(^SD(409.74,$PIECE(SDTOE,U,3),1)),U,4)
End DoDot:1
+9 IF '$TEST
IF $PIECE(SDTOE,U,2)
IF $PIECE(SDTOE,U,3)=""
Begin DoDot:1
+10 SET X=$PIECE($GET(^SCE($PIECE(SDTOE,U,2),0)),U,4)
End DoDot:1
+11 IF '$TEST
SET X=""
+12 IF X
SET X=$PIECE($GET(^SC(X,0)),U)
+13 QUIT
+14 ;
XDATE(D0) ;-- This function is used for the computed field 10.01 in file
+1 ; Transmitted OutPatinet Encounter Error file 409.75. For the given
+2 ; entry the x-mit date to NPCDB will be determined.
+3 NEW SDXDT
+4 SET X=""
+5 SET SDXDT=$PIECE($GET(^SD(409.73,+$PIECE($GET(^SD(409.75,D0,0)),U),1)),U)
+6 IF SDXDT
SET Y=SDXDT
XECUTE ^DD("DD")
SET X=$TRANSLATE(Y,"@"," ")
+7 QUIT
