- 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 Feb 19, 2025@00:06:07 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