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

BSDSCEC.m

Go to the documentation of this file. 
  1. BSDSCEC ; IHS/ANMC/LJF - PT ASSIGN DETAILS TEMPLATE ;
  1.  ;;5.3;PIMS;;APR 26, 2002
  1.  ;
  1. EN ; -- main entry point
  1.  NEW VALMCNT D TERM^VALM0,CLEAR^VALM1
  1.  D EN^VALM("BSDSC PT ASSIGNMENTS")
  1.  D CLEAR^VALM1
  1.  Q
  1.  ;
  1. HDR ; -- header code
  1.  Q
  1.  ;
  1. INIT ; -- init variables and list array
  1.  K ^TMP("BSDSCEC",$J),^TMP("BSDSCEC1",$J)
  1.  D GUIR^XBLM("IHS^SCRPEC","^TMP(""BSDSCEC1"",$J,")
  1.  S X=0 F  S X=$O(^TMP("BSDSCEC1",$J,X)) Q:'X  D
  1.  . S VALMCNT=X
  1.  . S ^TMP("BSDSCEC",$J,X,0)=^TMP("BSDSCEC1",$J,X)
  1.  K ^TMP("BSDSCEC1",$J)
  1.  Q
  1.  ;
  1. HELP ; -- help code
  1.  S X="?" D DISP^XQORM1 W !!
  1.  Q
  1.  ;
  1. EXIT ; -- exit code
  1.  K ^TMP("BSDSCEC",$J)
  1.  Q
  1.  ;
  1. EXPND ; -- expand code
  1.  Q
  1.  ;
  1. FORMAT(PTIEN,INS,TIEN,PDATA,CNAME,CIEN) ;EP; format data for report
  1.  ; called by FORMAT^SCRPEC2
  1.  ;PTIEN - patient ien
  1.  ;INS - institution ien
  1.  ;TIEN - team ien
  1.  ;PDATA - pt name^pid^mt^pelig^pstat^statd^last^next^pc prov.^assoc. prov.
  1.  ;CNAME - clinic name
  1.  ;CIEN - clinic ien
  1.  ;
  1.  S @STORE@(INS,TIEN,CIEN,PTIEN)=$E($P(PDATA,"^"),1,20)  ;patient name
  1.  S $E(@STORE@(INS,TIEN,CIEN,PTIEN),22)=$P(PDATA,"^",2)  ;primary id
  1.  S $E(@STORE@(INS,TIEN,CIEN,PTIEN),32)=$P(PDATA,"^",7)  ;last appt
  1.  S $E(@STORE@(INS,TIEN,CIEN,PTIEN),57)=$P(PDATA,"^",8)  ;next appt
  1.  S $E(@STORE@(INS,TIEN,CIEN,PTIEN),77)=$E($P(PDATA,U,9),1,18)  ;PC prov.
  1.  S $E(@STORE@(INS,TIEN,CIEN,PTIEN),95)=$E($P(PDATA,U,11),1,18)  ;PC prov.
  1.  S $E(@STORE@(INS,TIEN,CIEN,PTIEN),115)=$E($P(PDATA,U,10),1,18)  ;Assoc. Prov.
  1.  Q
  1.  ;
  1.  ; called by HEADER^SCRPEC2
  1.  N HLD
  1.  S HLD="H0"
  1.  S $E(@STORE@("SUBHEADER",HLD),32)="Last Team"
  1.  S $E(@STORE@("SUBHEADER",HLD),57)="Next Team"
  1.  S $E(@STORE@("SUBHEADER",HLD),77)="Primary Care"
  1.  S $E(@STORE@("SUBHEADER",HLD),95)="Non-PC"
  1.  S $E(@STORE@("SUBHEADER",HLD),115)="Associate"
  1.  S HLD="H1"
  1.  S @STORE@("SUBHEADER",HLD)="Patient Name"
  1.  S $E(@STORE@("SUBHEADER",HLD),22)="Pt ID"
  1.  S $E(@STORE@("SUBHEADER",HLD),32)="Appt/Clinic"
  1.  S $E(@STORE@("SUBHEADER",HLD),57)="Appt/Clinic"
  1.  S $E(@STORE@("SUBHEADER",HLD),77)="Provider"
  1.  S $E(@STORE@("SUBHEADER",HLD),95)="Provider"
  1.  S $E(@STORE@("SUBHEADER",HLD),115)="Provider"
  1.  S HLD="H2"
  1.  S $P(@STORE@("SUBHEADER",HLD),"=",133)=""
  1.  Q
  1.  ;
  1. GETAPPT(DFN,BSDTM,MODE) ;EP; find next/last appt for any clinic under team
  1.  ; called by PDATE^SCRPEC
  1.  ; BSDTM=team ien
  1.  ; MODE="LAST" or "NEXT"
  1.  ; BSDX1 will be set as array of providers on team
  1.  ; BSDX2 will be set as array of clinics for provider
  1.  ; returns ANS=appt date_"   "_clinic abbreviation
  1.  ;
  1.  NEW ANS,CLN,BSDATE,BSDX1,BSDX2
  1.  ; find all providers on team during last year
  1.  S BSDATE("BEGIN")=$$FMADD^XLFDT(DT,-365),BSDATE("END")=DT
  1.  S BSDATE("INCL")=0    ;include providers on team anytine in date range
  1.  S BSDX1=$$PROV^BSDU3(.BSDTM,.BSDATE,.ARRAY)
  1.  ;
  1.  ; for each provider, find all associated clinics
  1.  S ANS=$S(MODE="LAST":0,1:9999999)
  1.  S BSD=0 F  S BSD=$O(@BSDX1@(BSD)) Q:'BSD  D
  1.  . S PRV=$P(@BSDX1@(BSD),U) Q:'PRV
  1.  . K BSDX2 D CLINICS^BSDU3(PRV,.BSDX2)
  1.  . ;
  1.  . ; for each clinic, find last appt
  1.  . S CLN=0 F  S CLN=$O(BSDX2(CLN)) Q:'CLN  D
  1.  .. I MODE="LAST" D
  1.  ... S APPT=$$GETLAST^SCRPU3(DFN,CLN)    ;find last appt for clinic
  1.  ... I APPT>ANS S ANS=APPT_"   "_$$GET1^DIQ(44,CLN,1)
  1.  .. I MODE="NEXT" D
  1.  ... S APPT=$$GETNEXT^SCRPU3(DFN,CLN)    ;find next appt for clinic
  1.  ... I APPT,APPT<ANS S ANS=APPT_"   "_$$GET1^DIQ(44,CLN,1)
  1.  I ANS=9999999 S ANS=""
  1.  Q ANS