ORWPT1 ;SLC/KCM,ART - Patient Lookup Functions (cont) ;11/30/2015 07:09
;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,109,280,340,306,387,377**;Dec 17, 1997;Build 582
;
SAVDFLT ; continued from ORWPT, save new default patient list
N DAY,HOLDX S OK=1
I $P(X,U)="P" D
. D EN^XPAR(DUZ_";VA(200,","ORLP DEFAULT LIST SOURCE",1,"P")
. D EN^XPAR(DUZ_";VA(200,","ORLP DEFAULT PROVIDER",1,"`"_$P(X,U,2))
I $P(X,U)="T" D
. D EN^XPAR(DUZ_";VA(200,","ORLP DEFAULT LIST SOURCE",1,"T")
. D EN^XPAR(DUZ_";VA(200,","ORLP DEFAULT TEAM",1,"`"_$P(X,U,2))
I $P(X,U)="E" D
. D EN^XPAR(DUZ_";VA(200,","ORLP DEFAULT LIST SOURCE",1,"E")
. D EN^XPAR(DUZ_";VA(200,","ORLP DEFAULT PCMM TEAM",1,"`"_$P(X,U,2))
I $P(X,U)="S" D
. D EN^XPAR(DUZ_";VA(200,","ORLP DEFAULT LIST SOURCE",1,"S")
. D EN^XPAR(DUZ_";VA(200,","ORLP DEFAULT SPECIALTY",1,"`"_$P(X,U,2))
I $P(X,U)="C" D
. D EN^XPAR(DUZ_";VA(200,","ORLP DEFAULT LIST SOURCE",1,"C")
. F DAY="MONDAY","TUESDAY","WEDNESDAY","THURSDAY","FRIDAY","SATURDAY","SUNDAY" D EN^XPAR(DUZ_";VA(200,","ORLP DEFAULT CLINIC "_DAY,1,"`"_$P(X,U,2))
. D EN^XPAR(DUZ_";VA(200,","ORLP DEFAULT CLINIC START DATE",1,$P($P(X,U,3),";"))
. D EN^XPAR(DUZ_";VA(200,","ORLP 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,","ORLP 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,","ORLP DEFAULT CLINIC "_DAY,1,"`"_$P(X,U,2))
. D EN^XPAR(DUZ_";VA(200,","ORLP DEFAULT CLINIC START DATE",1,$P($P(X,U,3),";"))
. D EN^XPAR(DUZ_";VA(200,","ORLP DEFAULT CLINIC STOP DATE",1,$P($P(X,U,3),";",2))
I $P(X,U)="W" D
. D EN^XPAR(DUZ_";VA(200,","ORLP DEFAULT LIST SOURCE",1,"W")
. D EN^XPAR(DUZ_";VA(200,","ORLP 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 for CPRS Header
;Input - PATIENT = Patient DFN
;Output - VAL = Primary Care Team^PCP^Attending^AP^MH Treatment Coordinator/MH Team^Inpatient Provider
; for PCMM Web VAL = Primary Care Team/PCP/AP^^Attending^^MH Treatment Coordinator/MH Team^Inpatient Provider
;
; Source of PACT/PCP data for CPRS is 404.41/.06 - 387
; Other callers will get original data format
; ICR #6042 - SCMC PCMM/R GET PRIMARY CARE SUMMARY
;
N PCT,PCP,ATT,ASS,MHTC,INPROV,MHSTR
S (PCT,PCP,ATT,ASS,MHTC,INPROV,MHSTR)=""
;
;RPC Broker sets XQCY0 to the caller's context
IF $GET(XQCY0)["CPRSChart" DO ;check calling source
. S PCT=$$CPRSHEAD^SCMCWSUT(PATIENT) ;387
IF $GET(XQCY0)'["CPRSChart" DO
. S PCT=$P($$OUTPTTM^SDUTL3(PATIENT,DT),U,2)
. S PCP=$P($$OUTPTPR^SDUTL3(PATIENT,DT),U,2)
. S ASS=$P($$OUTPTAP^SDUTL3(PATIENT,DT),U,2)
;
S ATT=$G(^DPT(PATIENT,.1041)) I ATT S ATT=$P($G(^VA(200,ATT,0)),U)
S MHSTR=$$START^SCMCMHTC(PATIENT) ;387
S MHTC=$S($P(MHSTR,U,2)'="":$P(MHSTR,U,2)_" / "_$P(MHSTR,U,5),1:"") ;387 - mhtc/mh team
S INPROV=$G(^DPT(PATIENT,.104)) I INPROV S INPROV=$P($G(^VA(200,INPROV,0)),U)
S VAL=PCT_U_PCP_U_ATT_U_ASS_U_MHTC_U_INPROV
Q
;
PCDETAIL(LST,PATIENT) ; return Primary Care Detail information
;Input - PATIENT = Patient DFN
;Output - LST = Array of Patient Team Assignment Details
;
; Source of data for CPRS is now a web service call to PCMM Web - 387
; Other callers will get original data format
; ICR #6027 - SCMC PCMM/R GET PRIMARY CARE DETAILS
;
;new for PCMM Web requirements
;RPC Broker sets XQCY0 to the caller's context
IF $GET(XQCY0)["CPRSChart" DO QUIT
. DO PCDETAIL^SCMCWS1(.LST,PATIENT)
;
;original code
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)=" "
I $$INPT(PATIENT) D
. 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)
. E S ILST=ILST+1,LST(ILST)="No Attending Physician Assigned."
. S ILST=ILST+1,LST(ILST)=" "
. S X=$G(^DPT(PATIENT,.104))
. I +X D
. . S ILST=ILST+1,LST(ILST)=" Inpatient Provider: "_$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)
. E S ILST=ILST+1,LST(ILST)="No Inpatient Provider Assigned."
. S ILST=ILST+1,LST(ILST)=" "
S X=0
S X=$$START^SCMCMHTC(PATIENT) ;Retrieve Mental Health Provider
I +X>0 D
. S ILST=ILST+1,LST(ILST)=" MH Treatment Team: "_$P(X,U,5)
. S ILST=ILST+1,LST(ILST)=" MH Treatment Coordinator: "_$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 MH Treatment Coordinator Assigned."
Q
;
INPT(ORDFN) ;check if the patient is an inpatient
N RET S RET=0
I $D(^DPT(ORDFN,.1)) S RET=1
Q RET
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORWPT1 6627 printed Apr 09, 2024@21:33:13 Page 2
ORWPT1 ;SLC/KCM,ART - Patient Lookup Functions (cont) ;11/30/2015 07:09
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,109,280,340,306,387,377**;Dec 17, 1997;Build 582
+2 ;
SAVDFLT ; continued from ORWPT, 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,","ORLP DEFAULT LIST SOURCE",1,"P")
+4 DO EN^XPAR(DUZ_";VA(200,","ORLP 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,","ORLP DEFAULT LIST SOURCE",1,"T")
+7 DO EN^XPAR(DUZ_";VA(200,","ORLP DEFAULT TEAM",1,"`"_$PIECE(X,U,2))
End DoDot:1
+8 IF $PIECE(X,U)="E"
Begin DoDot:1
+9 DO EN^XPAR(DUZ_";VA(200,","ORLP DEFAULT LIST SOURCE",1,"E")
+10 DO EN^XPAR(DUZ_";VA(200,","ORLP DEFAULT PCMM TEAM",1,"`"_$PIECE(X,U,2))
End DoDot:1
+11 IF $PIECE(X,U)="S"
Begin DoDot:1
+12 DO EN^XPAR(DUZ_";VA(200,","ORLP DEFAULT LIST SOURCE",1,"S")
+13 DO EN^XPAR(DUZ_";VA(200,","ORLP DEFAULT SPECIALTY",1,"`"_$PIECE(X,U,2))
End DoDot:1
+14 IF $PIECE(X,U)="C"
Begin DoDot:1
+15 DO EN^XPAR(DUZ_";VA(200,","ORLP DEFAULT LIST SOURCE",1,"C")
+16 FOR DAY="MONDAY","TUESDAY","WEDNESDAY","THURSDAY","FRIDAY","SATURDAY","SUNDAY"
DO EN^XPAR(DUZ_";VA(200,","ORLP DEFAULT CLINIC "_DAY,1,"`"_$PIECE(X,U,2))
+17 DO EN^XPAR(DUZ_";VA(200,","ORLP DEFAULT CLINIC START DATE",1,$PIECE($PIECE(X,U,3),";"))
+18 DO EN^XPAR(DUZ_";VA(200,","ORLP DEFAULT CLINIC STOP DATE",1,$PIECE($PIECE(X,U,3),";",2))
End DoDot:1
+19 ; SLC/PKS - 6/25/2001
+20 ; Added section to save clinic defaults for current day only:
+21 IF $PIECE(X,U)="CT"
Begin DoDot:1
+22 DO EN^XPAR(DUZ_";VA(200,","ORLP DEFAULT LIST SOURCE",1,"C")
+23 SET HOLDX=X
+24 DO NOW^%DTC
DO DW^%DTC
SET DAY=X
SET X=HOLDX
+25 DO EN^XPAR(DUZ_";VA(200,","ORLP DEFAULT CLINIC "_DAY,1,"`"_$PIECE(X,U,2))
+26 DO EN^XPAR(DUZ_";VA(200,","ORLP DEFAULT CLINIC START DATE",1,$PIECE($PIECE(X,U,3),";"))
+27 DO EN^XPAR(DUZ_";VA(200,","ORLP DEFAULT CLINIC STOP DATE",1,$PIECE($PIECE(X,U,3),";",2))
End DoDot:1
+28 IF $PIECE(X,U)="W"
Begin DoDot:1
+29 DO EN^XPAR(DUZ_";VA(200,","ORLP DEFAULT LIST SOURCE",1,"W")
+30 DO EN^XPAR(DUZ_";VA(200,","ORLP DEFAULT WARD",1,"`"_$PIECE(X,U,2))
End DoDot:1
+31 IF $PIECE(X,U)="A"
DO DEL^XPAR(DUZ_";VA(200,","ORLP DEFAULT LIST SOURCE",1)
+32 QUIT
+33 ;
PRCARE(VAL,PATIENT) ; return Primary Care info for CPRS Header
+1 ;Input - PATIENT = Patient DFN
+2 ;Output - VAL = Primary Care Team^PCP^Attending^AP^MH Treatment Coordinator/MH Team^Inpatient Provider
+3 ; for PCMM Web VAL = Primary Care Team/PCP/AP^^Attending^^MH Treatment Coordinator/MH Team^Inpatient Provider
+4 ;
+5 ; Source of PACT/PCP data for CPRS is 404.41/.06 - 387
+6 ; Other callers will get original data format
+7 ; ICR #6042 - SCMC PCMM/R GET PRIMARY CARE SUMMARY
+8 ;
+9 NEW PCT,PCP,ATT,ASS,MHTC,INPROV,MHSTR
+10 SET (PCT,PCP,ATT,ASS,MHTC,INPROV,MHSTR)=""
+11 ;
+12 ;RPC Broker sets XQCY0 to the caller's context
+13 ;check calling source
IF $GET(XQCY0)["CPRSChart"
Begin DoDot:1
+14 ;387
SET PCT=$$CPRSHEAD^SCMCWSUT(PATIENT)
End DoDot:1
+15 IF $GET(XQCY0)'["CPRSChart"
Begin DoDot:1
+16 SET PCT=$PIECE($$OUTPTTM^SDUTL3(PATIENT,DT),U,2)
+17 SET PCP=$PIECE($$OUTPTPR^SDUTL3(PATIENT,DT),U,2)
+18 SET ASS=$PIECE($$OUTPTAP^SDUTL3(PATIENT,DT),U,2)
End DoDot:1
+19 ;
+20 SET ATT=$GET(^DPT(PATIENT,.1041))
IF ATT
SET ATT=$PIECE($GET(^VA(200,ATT,0)),U)
+21 ;387
SET MHSTR=$$START^SCMCMHTC(PATIENT)
+22 ;387 - mhtc/mh team
SET MHTC=$SELECT($PIECE(MHSTR,U,2)'="":$PIECE(MHSTR,U,2)_" / "_$PIECE(MHSTR,U,5),1:"")
+23 SET INPROV=$GET(^DPT(PATIENT,.104))
IF INPROV
SET INPROV=$PIECE($GET(^VA(200,INPROV,0)),U)
+24 SET VAL=PCT_U_PCP_U_ATT_U_ASS_U_MHTC_U_INPROV
+25 QUIT
+26 ;
PCDETAIL(LST,PATIENT) ; return Primary Care Detail information
+1 ;Input - PATIENT = Patient DFN
+2 ;Output - LST = Array of Patient Team Assignment Details
+3 ;
+4 ; Source of data for CPRS is now a web service call to PCMM Web - 387
+5 ; Other callers will get original data format
+6 ; ICR #6027 - SCMC PCMM/R GET PRIMARY CARE DETAILS
+7 ;
+8 ;new for PCMM Web requirements
+9 ;RPC Broker sets XQCY0 to the caller's context
+10 IF $GET(XQCY0)["CPRSChart"
Begin DoDot:1
+11 DO PCDETAIL^SCMCWS1(.LST,PATIENT)
End DoDot:1
QUIT
+12 ;
+13 ;original code
+14 NEW ILST,X
SET ILST=0
+15 SET X=$$OUTPTTM^SDUTL3(PATIENT,DT)
+16 IF +X>0
Begin DoDot:1
+17 SET ILST=ILST+1
SET LST(ILST)=" Primary Care Team: "_$PIECE(X,U,2)
+18 SET ILST=ILST+1
SET LST(ILST)=" Phone: "_$PIECE($GET(^SCTM(404.51,+X,0)),U,2)
End DoDot:1
+19 IF '$TEST
SET ILST=ILST+1
SET LST(ILST)="No Primary Care Team Assigned."
+20 SET ILST=ILST+1
SET LST(ILST)=" "
+21 SET X=$$OUTPTPR^SDUTL3(PATIENT,DT)
+22 IF +X>0
Begin DoDot:1
+23 SET ILST=ILST+1
SET LST(ILST)=" Primary Care Provider: "_$PIECE(X,U,2)
+24 SET ILST=ILST+1
SET LST(ILST)=" Analog Pager: "_$PIECE($GET(^VA(200,+X,.13)),U,7)
+25 SET ILST=ILST+1
SET LST(ILST)=" Digital Pager: "_$PIECE($GET(^VA(200,+X,.13)),U,8)
+26 SET ILST=ILST+1
SET LST(ILST)=" Office Phone: "_$PIECE($GET(^VA(200,+X,.13)),U,2)
End DoDot:1
+27 IF '$TEST
SET ILST=ILST+1
SET LST(ILST)="No Primary Care Provider Assigned."
+28 SET ILST=ILST+1
SET LST(ILST)=" "
+29 SET X=$$OUTPTAP^SDUTL3(PATIENT,DT)
+30 IF +X>0
Begin DoDot:1
+31 SET ILST=ILST+1
SET LST(ILST)=" Associate Provider: "_$PIECE(X,U,2)
+32 SET ILST=ILST+1
SET LST(ILST)=" Analog Pager: "_$PIECE($GET(^VA(200,+X,.13)),U,7)
+33 SET ILST=ILST+1
SET LST(ILST)=" Digital Pager: "_$PIECE($GET(^VA(200,+X,.13)),U,8)
+34 SET ILST=ILST+1
SET LST(ILST)=" Office Phone: "_$PIECE($GET(^VA(200,+X,.13)),U,2)
End DoDot:1
+35 IF '$TEST
SET ILST=ILST+1
SET LST(ILST)="No Associate Provider Assigned."
+36 SET ILST=ILST+1
SET LST(ILST)=" "
+37 IF $$INPT(PATIENT)
Begin DoDot:1
+38 SET X=$GET(^DPT(PATIENT,.1041))
+39 IF +X
Begin DoDot:2
+40 SET ILST=ILST+1
SET LST(ILST)=" Attending Physician: "_$PIECE($GET(^VA(200,+X,0)),U)
+41 SET ILST=ILST+1
SET LST(ILST)=" Analog Pager: "_$PIECE($GET(^VA(200,+X,.13)),U,7)
+42 SET ILST=ILST+1
SET LST(ILST)=" Digital Pager: "_$PIECE($GET(^VA(200,+X,.13)),U,8)
+43 SET ILST=ILST+1
SET LST(ILST)=" Office Phone: "_$PIECE($GET(^VA(200,+X,.13)),U,2)
End DoDot:2
+44 IF '$TEST
SET ILST=ILST+1
SET LST(ILST)="No Attending Physician Assigned."
+45 SET ILST=ILST+1
SET LST(ILST)=" "
+46 SET X=$GET(^DPT(PATIENT,.104))
+47 IF +X
Begin DoDot:2
+48 SET ILST=ILST+1
SET LST(ILST)=" Inpatient Provider: "_$PIECE($GET(^VA(200,+X,0)),U)
+49 SET ILST=ILST+1
SET LST(ILST)=" Analog Pager: "_$PIECE($GET(^VA(200,+X,.13)),U,7)
+50 SET ILST=ILST+1
SET LST(ILST)=" Digital Pager: "_$PIECE($GET(^VA(200,+X,.13)),U,8)
+51 SET ILST=ILST+1
SET LST(ILST)=" Office Phone: "_$PIECE($GET(^VA(200,+X,.13)),U,2)
End DoDot:2
+52 IF '$TEST
SET ILST=ILST+1
SET LST(ILST)="No Inpatient Provider Assigned."
+53 SET ILST=ILST+1
SET LST(ILST)=" "
End DoDot:1
+54 SET X=0
+55 ;Retrieve Mental Health Provider
SET X=$$START^SCMCMHTC(PATIENT)
+56 IF +X>0
Begin DoDot:1
+57 SET ILST=ILST+1
SET LST(ILST)=" MH Treatment Team: "_$PIECE(X,U,5)
+58 SET ILST=ILST+1
SET LST(ILST)=" MH Treatment Coordinator: "_$PIECE(X,U,2)
+59 SET ILST=ILST+1
SET LST(ILST)=" Analog Pager: "_$PIECE($GET(^VA(200,+X,.13)),U,7)
+60 SET ILST=ILST+1
SET LST(ILST)=" Digital Pager: "_$PIECE($GET(^VA(200,+X,.13)),U,8)
+61 SET ILST=ILST+1
SET LST(ILST)=" Office Phone: "_$PIECE($GET(^VA(200,+X,.13)),U,2)
End DoDot:1
+62 ;E S ILST=ILST+1,LST(ILST)="No MH Treatment Coordinator Assigned."
+63 QUIT
+64 ;
INPT(ORDFN) ;check if the patient is an inpatient
+1 NEW RET
SET RET=0
+2 IF $DATA(^DPT(ORDFN,.1))
SET RET=1
+3 QUIT RET
+4 ;
