- 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 Feb 19, 2025@00:03:43 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 ;