DGWPT1 ; SLC/KCM - Patient Lookup Functions (cont) ;3/1/01
;;5.3;Registration;**447**;Aug 13, 1993
;
SAVDFLT ; continued from DGWPT, save new default patient list
N DAY,HOLDX S OK=1
I $P(X,U)="P" D
. D EN^XPAR(DUZ_";VA(200,","DGLP DEFAULT LIST SOURCE",1,"P")
. D EN^XPAR(DUZ_";VA(200,","DGLP DEFAULT PROVIDER",1,"`"_$P(X,U,2))
I $P(X,U)="T" D
. D EN^XPAR(DUZ_";VA(200,","DGLP DEFAULT LIST SOURCE",1,"T")
. D EN^XPAR(DUZ_";VA(200,","DGLP DEFAULT TEAM",1,"`"_$P(X,U,2))
I $P(X,U)="S" D
. D EN^XPAR(DUZ_";VA(200,","DGLP DEFAULT LIST SOURCE",1,"S")
. D EN^XPAR(DUZ_";VA(200,","DGLP DEFAULT SPECIALTY",1,"`"_$P(X,U,2))
I $P(X,U)="C" D
. D EN^XPAR(DUZ_";VA(200,","DGLP DEFAULT LIST SOURCE",1,"C")
. F DAY="MONDAY","TUESDAY","WEDNESDAY","THURSDAY","FRIDAY","SATURDAY","SUNDAY" D EN^XPAR(DUZ_";VA(200,","DGLP DEFAULT CLINIC "_DAY,1,"`"_$P(X,U,2))
. D EN^XPAR(DUZ_";VA(200,","DGLP DEFAULT CLINIC START DATE",1,$P($P(X,U,3),";"))
. D EN^XPAR(DUZ_";VA(200,","DGLP DEFAULT CLINIC STOP DATE",1,$P($P(X,U,3),";",2))
; SLC/PKS - 6/25/2001
; Added section to save clinic defaults for current day only:
I $P(X,U)="CT" D
. D EN^XPAR(DUZ_";VA(200,","DGLP DEFAULT LIST SOURCE",1,"C")
. S HOLDX=X
. D NOW^%DTC D DW^%DTC S DAY=X S X=HOLDX
. D EN^XPAR(DUZ_";VA(200,","DGLP DEFAULT CLINIC "_DAY,1,"`"_$P(X,U,2))
. D EN^XPAR(DUZ_";VA(200,","DGLP DEFAULT CLINIC START DATE",1,$P($P(X,U,3),";"))
. D EN^XPAR(DUZ_";VA(200,","DGLP DEFAULT CLINIC STOP DATE",1,$P($P(X,U,3),";",2))
I $P(X,U)="W" D
. D EN^XPAR(DUZ_";VA(200,","DGLP DEFAULT LIST SOURCE",1,"W")
. D EN^XPAR(DUZ_";VA(200,","DGLP DEFAULT WARD",1,"`"_$P(X,U,2))
I $P(X,U)="A" D DEL^XPAR(DUZ_";VA(200,","ORLP DEFAULT LIST SOURCE",1)
Q
PRCARE(VAL,PATIENT) ; return Primary Care info
; VAL=Primary Care Team^Primary Care Provider^Attending
N PCT,PCP,ATT
S PCT=$P($$OUTPTTM^SDUTL3(PATIENT,DT),U,2)
S PCP=$P($$OUTPTPR^SDUTL3(PATIENT,DT),U,2)
S ATT=$G(^DPT(PATIENT,.1041)) I ATT S ATT=$P($G(^VA(200,ATT,0)),U)
S VAL=PCT_U_PCP_U_ATT
Q
PCDETAIL(LST,PATIENT) ; return Primary Care Detail information
N ILST,X S ILST=0
S X=$$OUTPTTM^SDUTL3(PATIENT,DT)
I +X>0 D
. S ILST=ILST+1,LST(ILST)=" Primary Care Team: "_$P(X,U,2)
. S ILST=ILST+1,LST(ILST)=" Phone: "_$P($G(^SCTM(404.51,+X,0)),U,2)
E S ILST=ILST+1,LST(ILST)="No Primary Care Team Assigned."
S ILST=ILST+1,LST(ILST)=" "
S X=$$OUTPTPR^SDUTL3(PATIENT,DT)
I +X>0 D
. S ILST=ILST+1,LST(ILST)="Primary Care Provider: "_$P(X,U,2)
. S ILST=ILST+1,LST(ILST)=" Analog Pager: "_$P($G(^VA(200,+X,.13)),U,7)
. S ILST=ILST+1,LST(ILST)=" Digital Pager: "_$P($G(^VA(200,+X,.13)),U,8)
. S ILST=ILST+1,LST(ILST)=" Office Phone: "_$P($G(^VA(200,+X,.13)),U,2)
E S ILST=ILST+1,LST(ILST)="No Primary Care Provider Assigned."
S ILST=ILST+1,LST(ILST)=" "
S X=$$OUTPTAP^SDUTL3(PATIENT,DT)
I +X>0 D
. S ILST=ILST+1,LST(ILST)=" Associate Provider: "_$P(X,U,2)
. S ILST=ILST+1,LST(ILST)=" Analog Pager: "_$P($G(^VA(200,+X,.13)),U,7)
. S ILST=ILST+1,LST(ILST)=" Digital Pager: "_$P($G(^VA(200,+X,.13)),U,8)
. S ILST=ILST+1,LST(ILST)=" Office Phone: "_$P($G(^VA(200,+X,.13)),U,2)
E S ILST=ILST+1,LST(ILST)="No Associate Provider Assigned."
S ILST=ILST+1,LST(ILST)=" "
S X=$G(^DPT(PATIENT,.1041))
I +X D
. S ILST=ILST+1,LST(ILST)=" Attending Physician: "_$P($G(^VA(200,+X,0)),U)
. S ILST=ILST+1,LST(ILST)=" Analog Pager: "_$P($G(^VA(200,+X,.13)),U,7)
. S ILST=ILST+1,LST(ILST)=" Digital Pager: "_$P($G(^VA(200,+X,.13)),U,8)
. S ILST=ILST+1,LST(ILST)=" Office Phone: "_$P($G(^VA(200,+X,.13)),U,2)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGWPT1 3699 printed Sep 23, 2025@20:35:11 Page 2
DGWPT1 ; SLC/KCM - Patient Lookup Functions (cont) ;3/1/01
+1 ;;5.3;Registration;**447**;Aug 13, 1993
+2 ;
SAVDFLT ; continued from DGWPT, save new default patient list
+1 NEW DAY,HOLDX
SET OK=1
+2 IF $PIECE(X,U)="P"
Begin DoDot:1
+3 DO EN^XPAR(DUZ_";VA(200,","DGLP DEFAULT LIST SOURCE",1,"P")
+4 DO EN^XPAR(DUZ_";VA(200,","DGLP DEFAULT PROVIDER",1,"`"_$PIECE(X,U,2))
End DoDot:1
+5 IF $PIECE(X,U)="T"
Begin DoDot:1
+6 DO EN^XPAR(DUZ_";VA(200,","DGLP DEFAULT LIST SOURCE",1,"T")
+7 DO EN^XPAR(DUZ_";VA(200,","DGLP DEFAULT TEAM",1,"`"_$PIECE(X,U,2))
End DoDot:1
+8 IF $PIECE(X,U)="S"
Begin DoDot:1
+9 DO EN^XPAR(DUZ_";VA(200,","DGLP DEFAULT LIST SOURCE",1,"S")
+10 DO EN^XPAR(DUZ_";VA(200,","DGLP DEFAULT SPECIALTY",1,"`"_$PIECE(X,U,2))
End DoDot:1
+11 IF $PIECE(X,U)="C"
Begin DoDot:1
+12 DO EN^XPAR(DUZ_";VA(200,","DGLP DEFAULT LIST SOURCE",1,"C")
+13 FOR DAY="MONDAY","TUESDAY","WEDNESDAY","THURSDAY","FRIDAY","SATURDAY","SUNDAY"
DO EN^XPAR(DUZ_";VA(200,","DGLP DEFAULT CLINIC "_DAY,1,"`"_$PIECE(X,U,2))
+14 DO EN^XPAR(DUZ_";VA(200,","DGLP DEFAULT CLINIC START DATE",1,$PIECE($PIECE(X,U,3),";"))
+15 DO EN^XPAR(DUZ_";VA(200,","DGLP DEFAULT CLINIC STOP DATE",1,$PIECE($PIECE(X,U,3),";",2))
End DoDot:1
+16 ; SLC/PKS - 6/25/2001
+17 ; Added section to save clinic defaults for current day only:
+18 IF $PIECE(X,U)="CT"
Begin DoDot:1
+19 DO EN^XPAR(DUZ_";VA(200,","DGLP DEFAULT LIST SOURCE",1,"C")
+20 SET HOLDX=X
+21 DO NOW^%DTC
DO DW^%DTC
SET DAY=X
SET X=HOLDX
+22 DO EN^XPAR(DUZ_";VA(200,","DGLP DEFAULT CLINIC "_DAY,1,"`"_$PIECE(X,U,2))
+23 DO EN^XPAR(DUZ_";VA(200,","DGLP DEFAULT CLINIC START DATE",1,$PIECE($PIECE(X,U,3),";"))
+24 DO EN^XPAR(DUZ_";VA(200,","DGLP DEFAULT CLINIC STOP DATE",1,$PIECE($PIECE(X,U,3),";",2))
End DoDot:1
+25 IF $PIECE(X,U)="W"
Begin DoDot:1
+26 DO EN^XPAR(DUZ_";VA(200,","DGLP DEFAULT LIST SOURCE",1,"W")
+27 DO EN^XPAR(DUZ_";VA(200,","DGLP DEFAULT WARD",1,"`"_$PIECE(X,U,2))
End DoDot:1
+28 IF $PIECE(X,U)="A"
DO DEL^XPAR(DUZ_";VA(200,","ORLP DEFAULT LIST SOURCE",1)
+29 QUIT
PRCARE(VAL,PATIENT) ; return Primary Care info
+1 ; VAL=Primary Care Team^Primary Care Provider^Attending
+2 NEW PCT,PCP,ATT
+3 SET PCT=$PIECE($$OUTPTTM^SDUTL3(PATIENT,DT),U,2)
+4 SET PCP=$PIECE($$OUTPTPR^SDUTL3(PATIENT,DT),U,2)
+5 SET ATT=$GET(^DPT(PATIENT,.1041))
IF ATT
SET ATT=$PIECE($GET(^VA(200,ATT,0)),U)
+6 SET VAL=PCT_U_PCP_U_ATT
+7 QUIT
PCDETAIL(LST,PATIENT) ; return Primary Care Detail information
+1 NEW ILST,X
SET ILST=0
+2 SET X=$$OUTPTTM^SDUTL3(PATIENT,DT)
+3 IF +X>0
Begin DoDot:1
+4 SET ILST=ILST+1
SET LST(ILST)=" Primary Care Team: "_$PIECE(X,U,2)
+5 SET ILST=ILST+1
SET LST(ILST)=" Phone: "_$PIECE($GET(^SCTM(404.51,+X,0)),U,2)
End DoDot:1
+6 IF '$TEST
SET ILST=ILST+1
SET LST(ILST)="No Primary Care Team Assigned."
+7 SET ILST=ILST+1
SET LST(ILST)=" "
+8 SET X=$$OUTPTPR^SDUTL3(PATIENT,DT)
+9 IF +X>0
Begin DoDot:1
+10 SET ILST=ILST+1
SET LST(ILST)="Primary Care Provider: "_$PIECE(X,U,2)
+11 SET ILST=ILST+1
SET LST(ILST)=" Analog Pager: "_$PIECE($GET(^VA(200,+X,.13)),U,7)
+12 SET ILST=ILST+1
SET LST(ILST)=" Digital Pager: "_$PIECE($GET(^VA(200,+X,.13)),U,8)
+13 SET ILST=ILST+1
SET LST(ILST)=" Office Phone: "_$PIECE($GET(^VA(200,+X,.13)),U,2)
End DoDot:1
+14 IF '$TEST
SET ILST=ILST+1
SET LST(ILST)="No Primary Care Provider Assigned."
+15 SET ILST=ILST+1
SET LST(ILST)=" "
+16 SET X=$$OUTPTAP^SDUTL3(PATIENT,DT)
+17 IF +X>0
Begin DoDot:1
+18 SET ILST=ILST+1
SET LST(ILST)=" Associate Provider: "_$PIECE(X,U,2)
+19 SET ILST=ILST+1
SET LST(ILST)=" Analog Pager: "_$PIECE($GET(^VA(200,+X,.13)),U,7)
+20 SET ILST=ILST+1
SET LST(ILST)=" Digital Pager: "_$PIECE($GET(^VA(200,+X,.13)),U,8)
+21 SET ILST=ILST+1
SET LST(ILST)=" Office Phone: "_$PIECE($GET(^VA(200,+X,.13)),U,2)
End DoDot:1
+22 IF '$TEST
SET ILST=ILST+1
SET LST(ILST)="No Associate Provider Assigned."
+23 SET ILST=ILST+1
SET LST(ILST)=" "
+24 SET X=$GET(^DPT(PATIENT,.1041))
+25 IF +X
Begin DoDot:1
+26 SET ILST=ILST+1
SET LST(ILST)=" Attending Physician: "_$PIECE($GET(^VA(200,+X,0)),U)
+27 SET ILST=ILST+1
SET LST(ILST)=" Analog Pager: "_$PIECE($GET(^VA(200,+X,.13)),U,7)
+28 SET ILST=ILST+1
SET LST(ILST)=" Digital Pager: "_$PIECE($GET(^VA(200,+X,.13)),U,8)
+29 SET ILST=ILST+1
SET LST(ILST)=" Office Phone: "_$PIECE($GET(^VA(200,+X,.13)),U,2)
End DoDot:1
+30 QUIT
