Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ORWPT1

ORWPT1.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. SAVDFLT ; continued from ORWPT, save new default patient list
  1. N DAY,HOLDX S OK=1
  1. I $P(X,U)="P" D
  1. . D EN^XPAR(DUZ_";VA(200,","ORLP DEFAULT LIST SOURCE",1,"P")
  1. . D EN^XPAR(DUZ_";VA(200,","ORLP DEFAULT PROVIDER",1,"`"_$P(X,U,2))
  1. I $P(X,U)="T" D
  1. . D EN^XPAR(DUZ_";VA(200,","ORLP DEFAULT LIST SOURCE",1,"T")
  1. . D EN^XPAR(DUZ_";VA(200,","ORLP DEFAULT TEAM",1,"`"_$P(X,U,2))
  1. I $P(X,U)="E" D
  1. . D EN^XPAR(DUZ_";VA(200,","ORLP DEFAULT LIST SOURCE",1,"E")
  1. . D EN^XPAR(DUZ_";VA(200,","ORLP DEFAULT PCMM TEAM",1,"`"_$P(X,U,2))
  1. I $P(X,U)="S" D
  1. . D EN^XPAR(DUZ_";VA(200,","ORLP DEFAULT LIST SOURCE",1,"S")
  1. . D EN^XPAR(DUZ_";VA(200,","ORLP DEFAULT SPECIALTY",1,"`"_$P(X,U,2))
  1. I $P(X,U)="C" D
  1. . D EN^XPAR(DUZ_";VA(200,","ORLP DEFAULT LIST SOURCE",1,"C")
  1. . F DAY="MONDAY","TUESDAY","WEDNESDAY","THURSDAY","FRIDAY","SATURDAY","SUNDAY" D EN^XPAR(DUZ_";VA(200,","ORLP DEFAULT CLINIC "_DAY,1,"`"_$P(X,U,2))
  1. . D EN^XPAR(DUZ_";VA(200,","ORLP DEFAULT CLINIC START DATE",1,$P($P(X,U,3),";"))
  1. . D EN^XPAR(DUZ_";VA(200,","ORLP DEFAULT CLINIC STOP DATE",1,$P($P(X,U,3),";",2))
  1. ; SLC/PKS - 6/25/2001
  1. ; Added section to save clinic defaults for current day only:
  1. I $P(X,U)="CT" D
  1. . D EN^XPAR(DUZ_";VA(200,","ORLP DEFAULT LIST SOURCE",1,"C")
  1. . S HOLDX=X
  1. . D NOW^%DTC D DW^%DTC S DAY=X S X=HOLDX
  1. . D EN^XPAR(DUZ_";VA(200,","ORLP DEFAULT CLINIC "_DAY,1,"`"_$P(X,U,2))
  1. . D EN^XPAR(DUZ_";VA(200,","ORLP DEFAULT CLINIC START DATE",1,$P($P(X,U,3),";"))
  1. . D EN^XPAR(DUZ_";VA(200,","ORLP DEFAULT CLINIC STOP DATE",1,$P($P(X,U,3),";",2))
  1. I $P(X,U)="W" D
  1. . D EN^XPAR(DUZ_";VA(200,","ORLP DEFAULT LIST SOURCE",1,"W")
  1. . D EN^XPAR(DUZ_";VA(200,","ORLP DEFAULT WARD",1,"`"_$P(X,U,2))
  1. I $P(X,U)="A" D DEL^XPAR(DUZ_";VA(200,","ORLP DEFAULT LIST SOURCE",1)
  1. Q
  1. ;
  1. PRCARE(VAL,PATIENT) ; return Primary Care info for CPRS Header
  1. ;Input - PATIENT = Patient DFN
  1. ;Output - VAL = Primary Care Team^PCP^Attending^AP^MH Treatment Coordinator/MH Team^Inpatient Provider
  1. ; for PCMM Web VAL = Primary Care Team/PCP/AP^^Attending^^MH Treatment Coordinator/MH Team^Inpatient Provider
  1. ;
  1. ; Source of PACT/PCP data for CPRS is 404.41/.06 - 387
  1. ; Other callers will get original data format
  1. ; ICR #6042 - SCMC PCMM/R GET PRIMARY CARE SUMMARY
  1. ;
  1. N PCT,PCP,ATT,ASS,MHTC,INPROV,MHSTR
  1. S (PCT,PCP,ATT,ASS,MHTC,INPROV,MHSTR)=""
  1. ;
  1. ;RPC Broker sets XQCY0 to the caller's context
  1. IF $GET(XQCY0)["CPRSChart" DO ;check calling source
  1. . S PCT=$$CPRSHEAD^SCMCWSUT(PATIENT) ;387
  1. IF $GET(XQCY0)'["CPRSChart" DO
  1. . S PCT=$P($$OUTPTTM^SDUTL3(PATIENT,DT),U,2)
  1. . S PCP=$P($$OUTPTPR^SDUTL3(PATIENT,DT),U,2)
  1. . S ASS=$P($$OUTPTAP^SDUTL3(PATIENT,DT),U,2)
  1. ;
  1. S ATT=$G(^DPT(PATIENT,.1041)) I ATT S ATT=$P($G(^VA(200,ATT,0)),U)
  1. S MHSTR=$$START^SCMCMHTC(PATIENT) ;387
  1. S MHTC=$S($P(MHSTR,U,2)'="":$P(MHSTR,U,2)_" / "_$P(MHSTR,U,5),1:"") ;387 - mhtc/mh team
  1. S INPROV=$G(^DPT(PATIENT,.104)) I INPROV S INPROV=$P($G(^VA(200,INPROV,0)),U)
  1. S VAL=PCT_U_PCP_U_ATT_U_ASS_U_MHTC_U_INPROV
  1. Q
  1. ;
  1. PCDETAIL(LST,PATIENT) ; return Primary Care Detail information
  1. ;Input - PATIENT = Patient DFN
  1. ;Output - LST = Array of Patient Team Assignment Details
  1. ;
  1. ; Source of data for CPRS is now a web service call to PCMM Web - 387
  1. ; Other callers will get original data format
  1. ; ICR #6027 - SCMC PCMM/R GET PRIMARY CARE DETAILS
  1. ;
  1. ;new for PCMM Web requirements
  1. ;RPC Broker sets XQCY0 to the caller's context
  1. IF $GET(XQCY0)["CPRSChart" DO QUIT
  1. . DO PCDETAIL^SCMCWS1(.LST,PATIENT)
  1. ;
  1. ;original code
  1. N ILST,X S ILST=0
  1. S X=$$OUTPTTM^SDUTL3(PATIENT,DT)
  1. I +X>0 D
  1. . S ILST=ILST+1,LST(ILST)=" Primary Care Team: "_$P(X,U,2)
  1. . S ILST=ILST+1,LST(ILST)=" Phone: "_$P($G(^SCTM(404.51,+X,0)),U,2)
  1. E S ILST=ILST+1,LST(ILST)="No Primary Care Team Assigned."
  1. S ILST=ILST+1,LST(ILST)=" "
  1. S X=$$OUTPTPR^SDUTL3(PATIENT,DT)
  1. I +X>0 D
  1. . S ILST=ILST+1,LST(ILST)=" Primary Care Provider: "_$P(X,U,2)
  1. . S ILST=ILST+1,LST(ILST)=" Analog Pager: "_$P($G(^VA(200,+X,.13)),U,7)
  1. . S ILST=ILST+1,LST(ILST)=" Digital Pager: "_$P($G(^VA(200,+X,.13)),U,8)
  1. . S ILST=ILST+1,LST(ILST)=" Office Phone: "_$P($G(^VA(200,+X,.13)),U,2)
  1. E S ILST=ILST+1,LST(ILST)="No Primary Care Provider Assigned."
  1. S ILST=ILST+1,LST(ILST)=" "
  1. S X=$$OUTPTAP^SDUTL3(PATIENT,DT)
  1. I +X>0 D
  1. . S ILST=ILST+1,LST(ILST)=" Associate Provider: "_$P(X,U,2)
  1. . S ILST=ILST+1,LST(ILST)=" Analog Pager: "_$P($G(^VA(200,+X,.13)),U,7)
  1. . S ILST=ILST+1,LST(ILST)=" Digital Pager: "_$P($G(^VA(200,+X,.13)),U,8)
  1. . S ILST=ILST+1,LST(ILST)=" Office Phone: "_$P($G(^VA(200,+X,.13)),U,2)
  1. E S ILST=ILST+1,LST(ILST)="No Associate Provider Assigned."
  1. S ILST=ILST+1,LST(ILST)=" "
  1. I $$INPT(PATIENT) D
  1. . S X=$G(^DPT(PATIENT,.1041))
  1. . I +X D
  1. . . S ILST=ILST+1,LST(ILST)=" Attending Physician: "_$P($G(^VA(200,+X,0)),U)
  1. . . S ILST=ILST+1,LST(ILST)=" Analog Pager: "_$P($G(^VA(200,+X,.13)),U,7)
  1. . . S ILST=ILST+1,LST(ILST)=" Digital Pager: "_$P($G(^VA(200,+X,.13)),U,8)
  1. . . S ILST=ILST+1,LST(ILST)=" Office Phone: "_$P($G(^VA(200,+X,.13)),U,2)
  1. . E S ILST=ILST+1,LST(ILST)="No Attending Physician Assigned."
  1. . S ILST=ILST+1,LST(ILST)=" "
  1. . S X=$G(^DPT(PATIENT,.104))
  1. . I +X D
  1. . . S ILST=ILST+1,LST(ILST)=" Inpatient Provider: "_$P($G(^VA(200,+X,0)),U)
  1. . . S ILST=ILST+1,LST(ILST)=" Analog Pager: "_$P($G(^VA(200,+X,.13)),U,7)
  1. . . S ILST=ILST+1,LST(ILST)=" Digital Pager: "_$P($G(^VA(200,+X,.13)),U,8)
  1. . . S ILST=ILST+1,LST(ILST)=" Office Phone: "_$P($G(^VA(200,+X,.13)),U,2)
  1. . E S ILST=ILST+1,LST(ILST)="No Inpatient Provider Assigned."
  1. . S ILST=ILST+1,LST(ILST)=" "
  1. S X=0
  1. S X=$$START^SCMCMHTC(PATIENT) ;Retrieve Mental Health Provider
  1. I +X>0 D
  1. . S ILST=ILST+1,LST(ILST)=" MH Treatment Team: "_$P(X,U,5)
  1. . S ILST=ILST+1,LST(ILST)=" MH Treatment Coordinator: "_$P(X,U,2)
  1. . S ILST=ILST+1,LST(ILST)=" Analog Pager: "_$P($G(^VA(200,+X,.13)),U,7)
  1. . S ILST=ILST+1,LST(ILST)=" Digital Pager: "_$P($G(^VA(200,+X,.13)),U,8)
  1. . S ILST=ILST+1,LST(ILST)=" Office Phone: "_$P($G(^VA(200,+X,.13)),U,2)
  1. ;E S ILST=ILST+1,LST(ILST)="No MH Treatment Coordinator Assigned."
  1. Q
  1. ;
  1. INPT(ORDFN) ;check if the patient is an inpatient
  1. N RET S RET=0
  1. I $D(^DPT(ORDFN,.1)) S RET=1
  1. Q RET
  1. ;