- DGWPT1 ; SLC/KCM - Patient Lookup Functions (cont) ;3/1/01
- ;;5.3;Registration;**447,1015**;Aug 13, 1993;Build 21
- ;
- 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
- DGWPT1 ; SLC/KCM - Patient Lookup Functions (cont) ;3/1/01
- +1 ;;5.3;Registration;**447,1015**;Aug 13, 1993;Build 21
- +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
