DGPMDD ;ALB/MRL - FILE 405 DD CALLS; 27 JAN 89] ; 6/27/07 11:05am
;;5.3;Registration;**41,129,755**;Aug 13, 1993;Build 3
ID ;Display Identifiers
N DGPMDISP
S DGPMDD(1)=$S($D(^DPT(+$P(DGPMDD,"^",3),0)):^(0),1:"")
S DGPMDISP(1)=$P(DGPMDD(1),"^")_" ("_$P(DGPMDD(1),"^",9)_")"
S DGPMDISP(1,"F")="?30"
S DGPMDISP(2)=$S($D(^DG(405.3,+$P(DGPMDD,"^",2),0)):$P(^(0),"^"),1:"TRANSACTION UNKNOWN")_": "
S DGPMDISP(2)=DGPMDISP(2)_$S($D(^DG(405.1,+$P(DGPMDD,"^",4),0)):$P(^(0),"^"),1:"UNKNOWN MOVEMENT TYPE")
S DGPMDISP(2,"F")="!?15"
D EN^DDIOL(.DGPMDISP)
K DGPMDD
Q
;
SCREEN(Y,DA,DGDT) ;screen called from various files/fields - select active providers in file 200
;File 405 - Patient Movement:
; Field .08 - Primary Care Physician
; Field .19 - Attending Physician
;File 2 - Patient:
; Field .104 - Provider
; Field .1041 - Attending Physician
;File 41.1 - Scheduled Admission:
; Field 5 - Provider
;File 45 - PTF, Subfile 45.02 (Field 50) - 501:
; Subfield 24 - Provider
;File 45.7 - Facility Treating Speciality, Subfile 45.701 (Field 10):
; Subfield .01 - Providers
;INPUT: Y=ien if file 200
; DA=record edited
; DGDT=date, either today's or date of movement
;date of movement is used for fields .19 (attending) & .08 (primary) in file 405.
;OUTPUT: 1 to select; 0 to not select
;
; begin patch *755*
; DBIA #2349 - ACTIVE PROVIDER will be used for validation.
; The INACTIVE DATE (#53.4) field will no longer be used.
; New Input selection logic...
; If input selection has the PROVIDER security key...
; the TERMINATION DATE (#9.2) and the PERSON CLASS (#8932.1) fields
; will be used to determine if selection is active in the
; NEW PERSON (#200) file for a given date.
;
;S:'+$G(DA) DA=0 S:'+$G(DGDT) DGDT=DT I '+$G(Y) Q 0
;N DGINACT,DGY S DGY=0,DGDT=$P(DGDT,".")
;I $D(^VA(200,"AK.PROVIDER",$P($G(^VA(200,+Y,0)),U),+Y)) D
;.S DGY=0,DGINACT=$G(^VA(200,+Y,"PS"))
;.S DGY=$S(DGINACT']"":1,'+$P(DGINACT,U,4):1,DGDT'>+$P(DGINACT,U,4):1,1:0)
;
N DGY S DGY=0
I +$G(Y) D
. S:'+$G(DA) DA=0 S:'+$G(DGDT) DGDT=DT S DGDT=$P(DGDT,".")
. I $D(^VA(200,"AK.PROVIDER",$P($G(^VA(200,+Y,0)),U),+Y)) D
. . I $$ACTIVPRV^PXAPI(+Y,DGDT) S DGY=1 ;DBIA #2349
; end patch *755*
Q DGY
;
HELP(DA,DGDT) ;executable help called from various files/fields - display active providers in file 200
;File 405 - Patient Movement:
; Field .08 - Primary Care Physician
; Field .19 - Attending Physician
;File 2 - Patient:
; Field .104 - Provider
; Field .1041 - Attending Physician
;File 41.1 - Scheduled Admission:
; Field 5 - Provider
;File 45 - PTF, Subfile 45.02 (Field 50) - 501:
; Subfield 24 - Provider
;File 45.7 - Facility Treating Speciality, Subfile 45.701 (Field 10):
; Subfield .01 - Providers
;INPUT: DA=record edited
; DGDT=date, either today's or date of movement
;date of movement is used for fields .08 (attending) & .19 (primary) in file 405.
S:'+$G(DGDT) DGDT=DT I '+$G(DA) Q
;OUTPUT: display of active providers
N D,DGINACT,DO,DIC,X
S X="??",DIC="^VA(200,",DIC(0)="EQ",D="AK.PROVIDER"
S DIC("S")="I $$SCREEN^DGPMDD(Y,DA,DGDT)"
D IX^DIC
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPMDD 3259 printed Dec 13, 2024@02:49:22 Page 2
DGPMDD ;ALB/MRL - FILE 405 DD CALLS; 27 JAN 89] ; 6/27/07 11:05am
+1 ;;5.3;Registration;**41,129,755**;Aug 13, 1993;Build 3
ID ;Display Identifiers
+1 NEW DGPMDISP
+2 SET DGPMDD(1)=$SELECT($DATA(^DPT(+$PIECE(DGPMDD,"^",3),0)):^(0),1:"")
+3 SET DGPMDISP(1)=$PIECE(DGPMDD(1),"^")_" ("_$PIECE(DGPMDD(1),"^",9)_")"
+4 SET DGPMDISP(1,"F")="?30"
+5 SET DGPMDISP(2)=$SELECT($DATA(^DG(405.3,+$PIECE(DGPMDD,"^",2),0)):$PIECE(^(0),"^"),1:"TRANSACTION UNKNOWN")_": "
+6 SET DGPMDISP(2)=DGPMDISP(2)_$SELECT($DATA(^DG(405.1,+$PIECE(DGPMDD,"^",4),0)):$PIECE(^(0),"^"),1:"UNKNOWN MOVEMENT TYPE")
+7 SET DGPMDISP(2,"F")="!?15"
+8 DO EN^DDIOL(.DGPMDISP)
+9 KILL DGPMDD
+10 QUIT
+11 ;
SCREEN(Y,DA,DGDT) ;screen called from various files/fields - select active providers in file 200
+1 ;File 405 - Patient Movement:
+2 ; Field .08 - Primary Care Physician
+3 ; Field .19 - Attending Physician
+4 ;File 2 - Patient:
+5 ; Field .104 - Provider
+6 ; Field .1041 - Attending Physician
+7 ;File 41.1 - Scheduled Admission:
+8 ; Field 5 - Provider
+9 ;File 45 - PTF, Subfile 45.02 (Field 50) - 501:
+10 ; Subfield 24 - Provider
+11 ;File 45.7 - Facility Treating Speciality, Subfile 45.701 (Field 10):
+12 ; Subfield .01 - Providers
+13 ;INPUT: Y=ien if file 200
+14 ; DA=record edited
+15 ; DGDT=date, either today's or date of movement
+16 ;date of movement is used for fields .19 (attending) & .08 (primary) in file 405.
+17 ;OUTPUT: 1 to select; 0 to not select
+18 ;
+19 ; begin patch *755*
+20 ; DBIA #2349 - ACTIVE PROVIDER will be used for validation.
+21 ; The INACTIVE DATE (#53.4) field will no longer be used.
+22 ; New Input selection logic...
+23 ; If input selection has the PROVIDER security key...
+24 ; the TERMINATION DATE (#9.2) and the PERSON CLASS (#8932.1) fields
+25 ; will be used to determine if selection is active in the
+26 ; NEW PERSON (#200) file for a given date.
+27 ;
+28 ;S:'+$G(DA) DA=0 S:'+$G(DGDT) DGDT=DT I '+$G(Y) Q 0
+29 ;N DGINACT,DGY S DGY=0,DGDT=$P(DGDT,".")
+30 ;I $D(^VA(200,"AK.PROVIDER",$P($G(^VA(200,+Y,0)),U),+Y)) D
+31 ;.S DGY=0,DGINACT=$G(^VA(200,+Y,"PS"))
+32 ;.S DGY=$S(DGINACT']"":1,'+$P(DGINACT,U,4):1,DGDT'>+$P(DGINACT,U,4):1,1:0)
+33 ;
+34 NEW DGY
SET DGY=0
+35 IF +$GET(Y)
Begin DoDot:1
+36 if '+$GET(DA)
SET DA=0
if '+$GET(DGDT)
SET DGDT=DT
SET DGDT=$PIECE(DGDT,".")
+37 IF $DATA(^VA(200,"AK.PROVIDER",$PIECE($GET(^VA(200,+Y,0)),U),+Y))
Begin DoDot:2
+38 ;DBIA #2349
IF $$ACTIVPRV^PXAPI(+Y,DGDT)
SET DGY=1
End DoDot:2
End DoDot:1
+39 ; end patch *755*
+40 QUIT DGY
+41 ;
HELP(DA,DGDT) ;executable help called from various files/fields - display active providers in file 200
+1 ;File 405 - Patient Movement:
+2 ; Field .08 - Primary Care Physician
+3 ; Field .19 - Attending Physician
+4 ;File 2 - Patient:
+5 ; Field .104 - Provider
+6 ; Field .1041 - Attending Physician
+7 ;File 41.1 - Scheduled Admission:
+8 ; Field 5 - Provider
+9 ;File 45 - PTF, Subfile 45.02 (Field 50) - 501:
+10 ; Subfield 24 - Provider
+11 ;File 45.7 - Facility Treating Speciality, Subfile 45.701 (Field 10):
+12 ; Subfield .01 - Providers
+13 ;INPUT: DA=record edited
+14 ; DGDT=date, either today's or date of movement
+15 ;date of movement is used for fields .08 (attending) & .19 (primary) in file 405.
+16 if '+$GET(DGDT)
SET DGDT=DT
IF '+$GET(DA)
QUIT
+17 ;OUTPUT: display of active providers
+18 NEW D,DGINACT,DO,DIC,X
+19 SET X="??"
SET DIC="^VA(200,"
SET DIC(0)="EQ"
SET D="AK.PROVIDER"
+20 SET DIC("S")="I $$SCREEN^DGPMDD(Y,DA,DGDT)"
+21 DO IX^DIC
+22 QUIT
