[613] | 1 | DGPMDD ;ALB/MRL - FILE 405 DD CALLS; 27 JAN 89] ; 6/27/07 11:05am
|
---|
| 2 | ;;5.3;Registration;**41,129,755**;Aug 13, 1993;Build 3
|
---|
| 3 | ID ;Display Identifiers
|
---|
| 4 | N DGPMDISP
|
---|
| 5 | S DGPMDD(1)=$S($D(^DPT(+$P(DGPMDD,"^",3),0)):^(0),1:"")
|
---|
| 6 | S DGPMDISP(1)=$P(DGPMDD(1),"^")_" ("_$P(DGPMDD(1),"^",9)_")"
|
---|
| 7 | S DGPMDISP(1,"F")="?30"
|
---|
| 8 | S DGPMDISP(2)=$S($D(^DG(405.3,+$P(DGPMDD,"^",2),0)):$P(^(0),"^"),1:"TRANSACTION UNKNOWN")_": "
|
---|
| 9 | S DGPMDISP(2)=DGPMDISP(2)_$S($D(^DG(405.1,+$P(DGPMDD,"^",4),0)):$P(^(0),"^"),1:"UNKNOWN MOVEMENT TYPE")
|
---|
| 10 | S DGPMDISP(2,"F")="!?15"
|
---|
| 11 | D EN^DDIOL(.DGPMDISP)
|
---|
| 12 | K DGPMDD
|
---|
| 13 | Q
|
---|
| 14 | ;
|
---|
| 15 | SCREEN(Y,DA,DGDT) ;screen called from various files/fields - select active providers in file 200
|
---|
| 16 | ;File 405 - Patient Movement:
|
---|
| 17 | ; Field .08 - Primary Care Physician
|
---|
| 18 | ; Field .19 - Attending Physician
|
---|
| 19 | ;File 2 - Patient:
|
---|
| 20 | ; Field .104 - Provider
|
---|
| 21 | ; Field .1041 - Attending Physician
|
---|
| 22 | ;File 41.1 - Scheduled Admission:
|
---|
| 23 | ; Field 5 - Provider
|
---|
| 24 | ;File 45 - PTF, Subfile 45.02 (Field 50) - 501:
|
---|
| 25 | ; Subfield 24 - Provider
|
---|
| 26 | ;File 45.7 - Facility Treating Speciality, Subfile 45.701 (Field 10):
|
---|
| 27 | ; Subfield .01 - Providers
|
---|
| 28 | ;INPUT: Y=ien if file 200
|
---|
| 29 | ; DA=record edited
|
---|
| 30 | ; DGDT=date, either today's or date of movement
|
---|
| 31 | ;date of movement is used for fields .19 (attending) & .08 (primary) in file 405.
|
---|
| 32 | ;OUTPUT: 1 to select; 0 to not select
|
---|
| 33 | ;
|
---|
| 34 | ; begin patch *755*
|
---|
| 35 | ; DBIA #2349 - ACTIVE PROVIDER will be used for validation.
|
---|
| 36 | ; The INACTIVE DATE (#53.4) field will no longer be used.
|
---|
| 37 | ; New Input selection logic...
|
---|
| 38 | ; If input selection has the PROVIDER security key...
|
---|
| 39 | ; the TERMINATION DATE (#9.2) and the PERSON CLASS (#8932.1) fields
|
---|
| 40 | ; will be used to determine if selection is active in the
|
---|
| 41 | ; NEW PERSON (#200) file for a given date.
|
---|
| 42 | ;
|
---|
| 43 | ;S:'+$G(DA) DA=0 S:'+$G(DGDT) DGDT=DT I '+$G(Y) Q 0
|
---|
| 44 | ;N DGINACT,DGY S DGY=0,DGDT=$P(DGDT,".")
|
---|
| 45 | ;I $D(^VA(200,"AK.PROVIDER",$P($G(^VA(200,+Y,0)),U),+Y)) D
|
---|
| 46 | ;.S DGY=0,DGINACT=$G(^VA(200,+Y,"PS"))
|
---|
| 47 | ;.S DGY=$S(DGINACT']"":1,'+$P(DGINACT,U,4):1,DGDT'>+$P(DGINACT,U,4):1,1:0)
|
---|
| 48 | ;
|
---|
| 49 | N DGY S DGY=0
|
---|
| 50 | I +$G(Y) D
|
---|
| 51 | . S:'+$G(DA) DA=0 S:'+$G(DGDT) DGDT=DT S DGDT=$P(DGDT,".")
|
---|
| 52 | . I $D(^VA(200,"AK.PROVIDER",$P($G(^VA(200,+Y,0)),U),+Y)) D
|
---|
| 53 | . . I $$ACTIVPRV^PXAPI(+Y,DGDT) S DGY=1 ;DBIA #2349
|
---|
| 54 | ; end patch *755*
|
---|
| 55 | Q DGY
|
---|
| 56 | ;
|
---|
| 57 | HELP(DA,DGDT) ;executable help called from various files/fields - display active providers in file 200
|
---|
| 58 | ;File 405 - Patient Movement:
|
---|
| 59 | ; Field .08 - Primary Care Physician
|
---|
| 60 | ; Field .19 - Attending Physician
|
---|
| 61 | ;File 2 - Patient:
|
---|
| 62 | ; Field .104 - Provider
|
---|
| 63 | ; Field .1041 - Attending Physician
|
---|
| 64 | ;File 41.1 - Scheduled Admission:
|
---|
| 65 | ; Field 5 - Provider
|
---|
| 66 | ;File 45 - PTF, Subfile 45.02 (Field 50) - 501:
|
---|
| 67 | ; Subfield 24 - Provider
|
---|
| 68 | ;File 45.7 - Facility Treating Speciality, Subfile 45.701 (Field 10):
|
---|
| 69 | ; Subfield .01 - Providers
|
---|
| 70 | ;INPUT: DA=record edited
|
---|
| 71 | ; DGDT=date, either today's or date of movement
|
---|
| 72 | ;date of movement is used for fields .08 (attending) & .19 (primary) in file 405.
|
---|
| 73 | S:'+$G(DGDT) DGDT=DT I '+$G(DA) Q
|
---|
| 74 | ;OUTPUT: display of active providers
|
---|
| 75 | N D,DGINACT,DO,DIC,X
|
---|
| 76 | S X="??",DIC="^VA(200,",DIC(0)="EQ",D="AK.PROVIDER"
|
---|
| 77 | S DIC("S")="I $$SCREEN^DGPMDD(Y,DA,DGDT)"
|
---|
| 78 | D IX^DIC
|
---|
| 79 | Q
|
---|