- 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 Feb 19, 2025@00:15:24 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