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

SCRPTP2.m

Go to the documentation of this file. 
  1. SCRPTP2 ;ALB/CMM - List of Team's Patients ; 29 Jun 99  04:11PM
  1.  ;;5.3;Scheduling;**41,53,52,174,177,231,526,520,1015**;AUG 13, 1993;Build 21
  1.  ;IHS/ANMC/LJF 11/03/2000 modified column headings
  1.  ;
  1.  ;List of Team's Patients Report
  1.  ;
  1. TFORMAT(INST,INAME,TIEN,TNAME,PHONE,PC) ; Format team information
  1.  ;INST - institution ien
  1.  ;INAME - institution name
  1.  ;TIEN - team ien
  1.  ;TNAME - team name
  1.  ;PHONE - team phone
  1.  ;PC - primary care team (yes/no)
  1.  ;
  1.  I INAME="" S INAME="[BAD DATA]"
  1.  I TNAME="" S TNAME="[BAD DATA]"
  1.  S @STORE@("I",INAME,INST)=""
  1.  S @STORE@("T",INST,TNAME,TIEN)=""
  1.  S @STORE@(INST)="Division: "_INAME
  1.  S @STORE@(INST,TIEN)="Team: "_TNAME
  1.  S $E(@STORE@(INST,TIEN),45)="Team Phone: "_PHONE
  1.  S @STORE@(INST,TIEN,1)="Primary Care Team: "_PC
  1.  Q
  1.  ;
  1. PRINTIT(STORE,TITL) ;
  1.  N INST,INAME,TNAME,TIEN
  1.  S (NEW,PAGE)=1,STOP=0 W:$E(IOST)="C" @IOF
  1.  D TITLE^SCRPU3(.PAGE,TITL,132) ;write title
  1.  D SETH
  1.  ;
  1.  S INAME=""
  1.  F  S INAME=$O(@STORE@("I",INAME)) Q:INAME=""!(STOP)  D
  1.  .S INST=$O(@STORE@("I",INAME,""))
  1.  .Q:INST=""
  1.  .I ('NEW)&(IOST'?1"C-".E) D NEWP1^SCRPU3(.PAGE,TITL,132)
  1.  .I ('NEW)&(IOST?1"C-".E) D HOLD^SCRPU3(.PAGE,TITL,132)
  1.  .Q:STOP
  1.  .W !,$G(@STORE@(INST)) ;write institution
  1.  .S TNAME=""
  1.  .F  S TNAME=$O(@STORE@("T",INST,TNAME)) Q:TNAME=""!(STOP)  D
  1.  ..S TIEN=$O(@STORE@("T",INST,TNAME,""))
  1.  ..Q:TIEN=""
  1.  ..D TPRINT(INST,TIEN) ;writes team info
  1.  ..Q:STOP
  1.  ..;
  1.  ..I (IOST'?1"C-".E)&($Y>(IOSL-4)) D NEWP1^SCRPU3(.PAGE,TITL,132)
  1.  ..I (IOST?1"C-".E)&($Y>(IOSL-4)) D HOLD^SCRPU3(.PAGE,TITL,132)
  1.  ..Q:STOP
  1.  ..D HEADER
  1.  ..I (SORT=3)!(SORT=4) D PRACT(INST,TIEN,.NEW)
  1.  ..I (SORT=1)!(SORT=2) D PTP(INST,TIEN,.NEW)
  1.  K NEW,PAGE
  1.  I 'STOP,$E(IOST)="C" N DIR S DIR(0)="E" W ! D ^DIR
  1.  Q
  1.  ;
  1. PRACT(INST,TIEN,NEW) ;Print by practitioner/patient
  1.  N PNAME,PIEN,SEC2,ST1,TRD,TRDI
  1.  S PNAME="",PIEN=""
  1.  F  S PNAME=$O(@STORE@("P",INST,TIEN,PNAME)) Q:PNAME=""!(STOP)  D
  1.  . F  S PIEN=$O(@STORE@("P",INST,TIEN,PNAME,PIEN)) Q:PIEN=""!(STOP)  D
  1.  . . I (SORT=1)!(SORT=3) S SEC2="""PT""" ;sort by patient name
  1.  . . I (SORT=2)!(SORT=4) S SEC2="""PID""" ;sort by last 4 PID
  1.  . . S ST1=$E(STORE,1,$L(STORE)-1)_","_SEC2_")"
  1.  . . I (IOST'?1"C-".E)&($Y>(IOSL-4)) D NEWP1^SCRPU3(.PAGE,TITL,132) D:'STOP HEADER
  1.  . . Q:STOP
  1.  . . I (IOST?1"C-".E)&($Y>(IOSL-4)) D HOLD^SCRPU3(.PAGE,TITL,132) D:'STOP HEADER
  1.  . . Q:STOP
  1.  . . S (TRDI,TRD)=""
  1.  . . F  S TRD=$O(@ST1@(INST,TIEN,TRD)) Q:TRD=""!(STOP)  D
  1.  . . . F  S TRDI=$O(@ST1@(INST,TIEN,TRD,TRDI)) Q:TRDI=""!(STOP)  D
  1.  . . . . I (IOST'?1"C-".E)&($Y>(IOSL-4)) D NEWP1^SCRPU3(.PAGE,TITL,132) D:'STOP HEADER
  1.  . . . . Q:STOP
  1.  . . . . I (IOST?1"C-".E)&($Y>(IOSL-4)) D HOLD^SCRPU3(.PAGE,TITL,132) D:'STOP HEADER
  1.  . . . . Q:STOP
  1.  . . . . I $D(@STORE@(INST,TIEN,PIEN,TRDI)) W !,$G(@STORE@(INST,TIEN,PIEN,TRDI)) ;write column data
  1.  . . . . N SCACL
  1.  . . . . S SCACL="" F  S SCACL=$O(@STORE@(INST,TIEN,PIEN,TRDI,SCACL)) Q:SCACL=""  D
  1.  . . . . . W !,$G(@STORE@(INST,TIEN,PIEN,TRDI,SCACL))
  1.  . S NEW=0
  1.  Q
  1.  ;
  1. PTP(INST,TIEN,NEW) ;Print by patient/practitioner
  1.  N SEC2,ST1,TRDI,TRD,PNAME,PIEN
  1.  I (SORT=1)!(SORT=3) S SEC2="""PT""" ;sort by patient name
  1.  I (SORT=2)!(SORT=4) S SEC2="""PID""" ;sort by last 4 PID
  1.  S ST1=$E(STORE,1,$L(STORE)-1)_","_SEC2_")"
  1.  I (IOST'?1"C-".E)&($Y>(IOSL-4)) D NEWP1^SCRPU3(.PAGE,TITL,132)
  1.  I (IOST?1"C-".E)&($Y>(IOSL-4)) D HOLD^SCRPU3(.PAGE,TITL,132)
  1.  Q:STOP
  1.  S (TRDI,TRD)=""
  1.  F  S TRD=$O(@ST1@(INST,TIEN,TRD)) Q:TRD=""!(STOP)  D
  1.  . F  S TRDI=$O(@ST1@(INST,TIEN,TRD,TRDI)) Q:TRDI=""!(STOP)  D
  1.  . . I (IOST'?1"C-".E)&($Y>(IOSL-4)) D NEWP1^SCRPU3(.PAGE,TITL,132) D:'STOP HEADER
  1.  . . Q:STOP
  1.  . . I (IOST?1"C-".E)&($Y>(IOSL-4)) D HOLD^SCRPU3(.PAGE,TITL,132) D:'STOP HEADER
  1.  . . Q:STOP
  1.  . . S PNAME="",PIEN=""
  1.  . . F  S PNAME=$O(@STORE@("P",INST,TIEN,PNAME)) Q:PNAME=""!(STOP)!(PIEN=0)  D
  1.  . . . F  S PIEN=$O(@STORE@("P",INST,TIEN,PNAME,PIEN)) Q:PIEN=""!(STOP)  D
  1.  . . . . I (IOST'?1"C-".E)&($Y>(IOSL-4)) D NEWP1^SCRPU3(.PAGE,TITL,132) D:'STOP HEADER
  1.  . . . . Q:STOP
  1.  . . . . I (IOST?1"C-".E)&($Y>(IOSL-4)) D HOLD^SCRPU3(.PAGE,TITL,132) D:'STOP HEADER
  1.  . . . . Q:STOP
  1.  . . . . I $D(@STORE@(INST,TIEN,TRDI,PIEN)) W !,$G(@STORE@(INST,TIEN,TRDI,PIEN)) ;write column data
  1.  . . . . N SCACL
  1.  . . . . S SCACL="" F  S SCACL=$O(@STORE@(INST,TIEN,TRDI,PIEN,SCACL)) Q:SCACL=""  D
  1.  . . . . . W !,$G(@STORE@(INST,TIEN,TRDI,PIEN,SCACL))
  1.  . S NEW=0
  1.  Q
  1.  ;
  1. TPRINT(INST,TIEN) ;
  1.  ;prints team data
  1.  N NXT
  1.  I (IOST'?1"C-".E)&($Y>(IOSL-13)) D NEWP1^SCRPU3(.PAGE,TITL,132) W:'STOP !,$G(@STORE@(INST))
  1.  I (IOST?1"C-".E)&($Y>(IOSL-13)) D HOLD^SCRPU3(.PAGE,TITL,132) W:'STOP !,$G(@STORE@(INST))
  1.  Q:STOP
  1.  W !!,$G(@STORE@(INST,TIEN))
  1.  S NXT=0
  1.  W !,$G(@STORE@(INST,TIEN,1)) ;write team info
  1.  Q:'$D(@STORE@(INST,TIEN,"D"))  W !
  1.  S NXT=""
  1.  ;write team description
  1.  F  S NXT=$O(@STORE@(INST,TIEN,"D",NXT)) Q:NXT=""!(STOP)  D
  1.  .I (IOST'?1"C-".E)&$Y>(IOSL-13) D NEWP1^SCRPU3(.PAGE,TITL,132) W:'STOP !,$G(@STORE@(INST))
  1.  .I (IOST?1"C-".E)&$Y>(IOSL-13) D HOLD^SCRPU3(.PAGE,TITL,132) W:'STOP !,$G(@STORE@(INST))
  1.  .Q:STOP
  1.  .W !,$G(@STORE@(INST,TIEN,"D",NXT))
  1.  W !!,"[Not Assigned] = Patient assigned to Team but not to a position/provider"
  1.  W !,"[Inactive Position] = Patient assigned to Team & Position but has no active provider"
  1.  Q
  1.  ;
  1.  N NXT
  1.  F NXT="H1","H2","H3" D
  1.  .W !,$G(@STORE@(NXT))
  1.  Q
  1.  ;
  1. SETH ;sets column headings
  1.  S @STORE@("H2")="Patient Name"
  1.  S $E(@STORE@("H2"),18)="Pt ID"
  1.  ;S $E(@STORE@("H2"),32)="Practitioner"  ;IHS/ANMC/LJF 11/03/2000
  1.  S $E(@STORE@("H2"),34)="Practitioner"   ;IHS/ANMC/LJF 11/03/2000
  1.  S $E(@STORE@("H2"),56)="Role"
  1.  S $E(@STORE@("H2"),80)="PC?"
  1.  S $E(@STORE@("H1"),85)="Last"
  1.  S $E(@STORE@("H2"),85)="Appt."
  1.  ;S $E(@STORE@("H1"),97)="Next"          ;IHS/ANMC/LJF 11/03/2000
  1.  S $E(@STORE@("H1"),105)="Next"          ;IHS/ANMC/LJF 11/03/2000
  1.  ;S $E(@STORE@("H2"),97)="Appt."         ;IHS/ANMC/LJF 11/03/2000
  1.  S $E(@STORE@("H2"),105)="Appt."         ;IHS/ANMC/LJF 11/03/2000
  1.  ;S $E(@STORE@("H2"),109)="Associated Clinic"  ;IHS/ANMC/LJF 11/03/2000
  1.  S $P(@STORE@("H3"),"=",133)=""
  1.  Q