Changeset 623 for WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCRPITP2.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCRPITP2.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCRPITP2.m
r613 r623 1 SCRPITP2 ;ALB/CMM - Individual Team Profile Continued ;7/25/99 18:24 2 ;;5.3;Scheduling;**41,177,520**;AUG 13, 1993;Build 26 3 ; 4 ;Individual Team Profile 5 ; 6 KEEP(TNODE,TPOS,TM,SCEN) ; 7 ;TNODE - zero node of the team position file entry TPOS 8 ;TPOS - ien of team position file entry TNODE 9 ;TM - ien of team 10 ; 11 N POS,PPC,CLIEN,PCLIN,MAX,ROL,CIEN,DIV 12 N SCRDATE,SCI,PROVLIST,SCPROV,SCPTASS,ERR 13 ; 14 D TEAM(TM,.DIV) 15 ; 16 S POS=$P(TNODE,"^") ;position name 17 S ROL=$P($G(^SD(403.46,+$P(TNODE,"^",3),0)),"^") ;standard position 18 S PPC=$S($P(TNODE,"^",4)'=1:"NPC",+$$OKPREC3^SCMCLK(TPOS,DT)>0:" AP",1:"PCP") ;primary care position 19 S MAX=$P(TNODE,"^",8) 20 ; 21 S SCRDATE="SCRDATE",(SCRDATE("BEGIN"),SCRDATE("END"))=DT,SCRDATE("INCL")=0 22 S SCI="PROVLIST",SCI=$$PRTP^SCAPMC(TPOS,.SCRDATE,SCI,"ERR",1,0) 23 S SCPROV=$P($G(PROVLIST(1)),U,2) 24 S SCPTASS=$$PCPOSCNT^SCAPMCU1(TPOS,DT,0) 25 ; 26 ;D FORMAT(POS,PPC,MAX,DIV,TM,TPOS,ROL,SCPROV,SCPTASS) 27 ; 28 D SETASCL^SCRPRAC2(TPOS,.CNAME,.CLIEN) 29 S CNAME=$G(CNAME(0)) 30 ;S CIEN=+$P(TNODE,"^",9) ;clinic ien ;USING MULTIPLE WITH SD*5.3*520 31 ;S PCLIN="" 32 ;I CIEN>0 S PCLIN=$P($G(^SC(CIEN,0)),"^") ;associated clinic 33 ; 34 D FORMAT(POS,PPC,MAX,DIV,TM,TPOS,ROL,CNAME,SCPROV,SCPTASS) 35 N AC 36 S AC=0 37 F S AC=$O(CNAME(AC)) Q:AC="" D FORMATAC(POS,DIV,TM,TPOS,CNAME(AC)) 38 K CNAME 39 Q 40 ; 41 TEAM(TM,DIV) ; 42 ; 43 N TMN,TNAME,TDIV,TPHONE,TPC,TSERV,STAT,PUR,MAX,CUR 44 S TMN=$G(^SCTM(404.51,TM,0)) ;zero node of team file 45 S TNAME=$P(TMN,"^") ;team name 46 S DIV=+$P(TMN,"^",7) ;division ien 47 S TDIV=$P($G(^DIC(4,DIV,0)),"^") ;team division 48 S TPHONE=$P(TMN,"^",2) ;team phone 49 S TPC=+$P(TMN,"^",5) ;Primary Care Team ien 50 S TSERV=$P($G(^DIC(49,+$P(TMN,"^",6),0)),"^") ;Service/section 51 S STAT=$S(+$$ACTTM^SCMCTMU(TM)=1:"ACTIVE",1:"INACTIVE") ;Team status 52 S PUR=$P($G(^SD(403.47,+$P(TMN,"^",3),0)),"^") 53 S MAX=$P(TMN,"^",8) 54 S CUR=$$TEAMCNT^SCAPMCU1(TM,DT) 55 D TFORMAT(TNAME,DIV,TDIV,TM,TPHONE,TPC,TSERV,STAT,PUR,MAX,CUR) 56 ; 57 ;GET TEAM DESCRIPTION (WORD PROCESSING FIELD) 58 D TDESC(TM,DIV) 59 Q 60 TDESC(TEM,DIV) ; 61 ;gets team description - word processing field 62 Q:'$O(^SCTM(404.51,TEM,"D",0)) 63 N EN 64 S EN=0 65 S @STORE@(DIV,TEM,"D",0)="Team Description: " 66 S @STORE@(DIV,TEM,"D",.5)="" 67 F S EN=$O(^SCTM(404.51,TEM,"D",EN)) Q:EN="" D 68 .S @STORE@(DIV,TEM,"D",EN)=$G(^SCTM(404.51,TEM,"D",EN,0)) 69 Q 70 ; 71 TFORMAT(TNAME,DIV,TDIV,TM,TPHONE,TPC,TSERV,STAT,PUR,MAX,CUR) ; 72 ; 73 I TNAME="" S TNAME="[BAD DATA]" 74 I TDIV="" S TDIV="[BAD DATA]" 75 S @STORE@("I",TDIV,DIV)="" 76 S @STORE@("T",DIV,TNAME,TM)="" 77 S @STORE@(DIV)="Division: "_TDIV 78 ; 79 S @STORE@(DIV,TM,"TI",1)="Team Name: "_TNAME 80 S $E(@STORE@(DIV,TM,"TI",1),44)="Service/Section: "_$E(TSERV,1,30) 81 S $E(@STORE@(DIV,TM,"TI",1),(120-$L(TPHONE)))="Team Phone: "_TPHONE 82 S @STORE@(DIV,TM,"TI",2)="" 83 S @STORE@(DIV,TM,"TI",3)="Team Settings:" 84 S @STORE@(DIV,TM,"TI",4)="" 85 S @STORE@(DIV,TM,"TI",5)="Status: "_STAT 86 S $E(@STORE@(DIV,TM,"TI",5),19)="Maximum Patients: "_MAX 87 S $E(@STORE@(DIV,TM,"TI",5),47)="Unique Patients Assigned: "_CUR 88 S $E(@STORE@(DIV,TM,"TI",5),83)="Purpose: "_$E(PUR,1,35) 89 S @STORE@(DIV,TM,"TI",6)="" 90 I CUR+1>MAX S @STORE@(DIV,TM,"TI",7)="This team is not accepting patients." 91 I CUR<MAX,CUR'=MAX S @STORE@(DIV,TM,"TI",7)="This team is still accepting patients." 92 Q 93 ; 94 FORMAT(POS,PPC,MAX,DIV,TM,TPOS,ROL,CNAME,SCPROV,SCPTASS) ; 95 ; 96 I POS="" S POS="[BAD DATA]" 97 S @STORE@(DIV,TM,"P",POS)=$E(POS,1,24) ;position 98 S $E(@STORE@(DIV,TM,"P",POS),27)=$E(SCPROV,1,24) ;provider 99 S $E(@STORE@(DIV,TM,"P",POS),53)=$E(ROL,1,24) ;standard role 100 S $E(@STORE@(DIV,TM,"P",POS),77)=PPC ;primary care yes/no 101 S $E(@STORE@(DIV,TM,"P",POS),82)=$J(MAX,6,0) ;number of patients allowed 102 S $E(@STORE@(DIV,TM,"P",POS),92)=$J(SCPTASS,6,0) ;patients assigned 103 S $E(@STORE@(DIV,TM,"P",POS),103)=$E(CNAME,1,30) 104 Q 105 ; 106 FORMATAC(POS,DIV,TM,TPOS,CNAME) ;clinic name 107 S $E(@STORE@(DIV,TM,"P",POS,AC),103)=$E(CNAME,1,30) 108 Q 109 ; 110 FORHEAD ; 111 S @STORE@("C",2)="Team Position" 112 S $E(@STORE@("C",2),27)="Provider Name" 113 S $E(@STORE@("C",2),53)="Standard Role" 114 S $E(@STORE@("C",2),77)="PC?" 115 S $E(@STORE@("C",1),82)="Patients" 116 S $E(@STORE@("C",2),82)="Allowed" 117 S $E(@STORE@("C",1),92)="Patients" 118 S $E(@STORE@("C",2),92)="Assigned" 119 S $E(@STORE@("C",2),103)="Associated Clinic" 120 S $P(@STORE@("C",3),"=",133)="" 121 Q 122 ; 123 CONT ;Team continuation header 124 W !,"Team '",TNAME,"' continued..." 125 COLUMN ; 126 I STOP Q 127 N EN 128 S EN=0 129 F S EN=$O(@STORE@("C",EN)) Q:EN="" D 130 .W !,$G(@STORE@("C",EN)) 131 Q 132 ; 1 SCRPITP2 ;ALB/CMM - Individual Team Profile Continued ;7/25/99 18:24 2 ;;5.3;Scheduling;**41,177**;AUG 13, 1993 3 ; 4 ;Individual Team Profile 5 ; 6 KEEP(TNODE,TPOS,TM,SCEN) ; 7 ;TNODE - zero node of the team position file entry TPOS 8 ;TPOS - ien of team position file entry TNODE 9 ;TM - ien of team 10 ; 11 N POS,PPC,CLIEN,PCLIN,MAX,ROL,CIEN,DIV 12 N SCRDATE,SCI,PROVLIST,SCPROV,SCPTASS,ERR 13 ; 14 D TEAM(TM,.DIV) 15 ; 16 S POS=$P(TNODE,"^") ;position name 17 S ROL=$P($G(^SD(403.46,+$P(TNODE,"^",3),0)),"^") ;standard position 18 S PPC=$S($P(TNODE,"^",4)'=1:"NPC",+$$OKPREC3^SCMCLK(TPOS,DT)>1:" AP",1:"PCP") ;primary care position 19 S MAX=$P(TNODE,"^",8) 20 ; 21 S SCRDATE="SCRDATE",(SCRDATE("BEGIN"),SCRDATE("END"))=DT,SCRDATE("INCL")=0 22 S SCI="PROVLIST",SCI=$$PRTP^SCAPMC(TPOS,.SCRDATE,SCI,"ERR",1,0) 23 S SCPROV=$P($G(PROVLIST(1)),U,2) 24 S SCPTASS=$$PCPOSCNT^SCAPMCU1(TPOS,DT,0) 25 ; 26 S CIEN=+$P(TNODE,"^",9) ;clinic ien 27 S PCLIN="" 28 I CIEN>0 S PCLIN=$P($G(^SC(CIEN,0)),"^") ;associated clinic 29 ; 30 D FORMAT(POS,PPC,MAX,DIV,TM,TPOS,ROL,PCLIN,SCPROV,SCPTASS) 31 ; 32 Q 33 ; 34 TEAM(TM,DIV) ; 35 ; 36 N TMN,TNAME,TDIV,TPHONE,TPC,TSERV,STAT,PUR,MAX,CUR 37 S TMN=$G(^SCTM(404.51,TM,0)) ;zero node of team file 38 S TNAME=$P(TMN,"^") ;team name 39 S DIV=+$P(TMN,"^",7) ;division ien 40 S TDIV=$P($G(^DIC(4,DIV,0)),"^") ;team division 41 S TPHONE=$P(TMN,"^",2) ;team phone 42 S TPC=+$P(TMN,"^",5) ;Primary Care Team ien 43 S TSERV=$P($G(^DIC(49,+$P(TMN,"^",6),0)),"^") ;Service/section 44 S STAT=$S(+$$ACTTM^SCMCTMU(TM)=1:"ACTIVE",1:"INACTIVE") ;Team status 45 S PUR=$P($G(^SD(403.47,+$P(TMN,"^",3),0)),"^") 46 S MAX=$P(TMN,"^",8) 47 S CUR=$$TEAMCNT^SCAPMCU1(TM,DT) 48 D TFORMAT(TNAME,DIV,TDIV,TM,TPHONE,TPC,TSERV,STAT,PUR,MAX,CUR) 49 ; 50 ;GET TEAM DESCRIPTION (WORD PROCESSING FIELD) 51 D TDESC(TM,DIV) 52 Q 53 TDESC(TEM,DIV) ; 54 ;gets team description - word processing field 55 Q:'$O(^SCTM(404.51,TEM,"D",0)) 56 N EN 57 S EN=0 58 S @STORE@(DIV,TEM,"D",0)="Team Description: " 59 S @STORE@(DIV,TEM,"D",.5)="" 60 F S EN=$O(^SCTM(404.51,TEM,"D",EN)) Q:EN="" D 61 .S @STORE@(DIV,TEM,"D",EN)=$G(^SCTM(404.51,TEM,"D",EN,0)) 62 Q 63 ; 64 TFORMAT(TNAME,DIV,TDIV,TM,TPHONE,TPC,TSERV,STAT,PUR,MAX,CUR) ; 65 ; 66 I TNAME="" S TNAME="[BAD DATA]" 67 I TDIV="" S TDIV="[BAD DATA]" 68 S @STORE@("I",TDIV,DIV)="" 69 S @STORE@("T",DIV,TNAME,TM)="" 70 S @STORE@(DIV)="Division: "_TDIV 71 ; 72 S @STORE@(DIV,TM,"TI",1)="Team Name: "_TNAME 73 S $E(@STORE@(DIV,TM,"TI",1),44)="Service/Section: "_$E(TSERV,1,30) 74 S $E(@STORE@(DIV,TM,"TI",1),(120-$L(TPHONE)))="Team Phone: "_TPHONE 75 S @STORE@(DIV,TM,"TI",2)="" 76 S @STORE@(DIV,TM,"TI",3)="Team Settings:" 77 S @STORE@(DIV,TM,"TI",4)="" 78 S @STORE@(DIV,TM,"TI",5)="Status: "_STAT 79 S $E(@STORE@(DIV,TM,"TI",5),19)="Maximum Patients: "_MAX 80 S $E(@STORE@(DIV,TM,"TI",5),47)="Unique Patients Assigned: "_CUR 81 S $E(@STORE@(DIV,TM,"TI",5),83)="Purpose: "_$E(PUR,1,35) 82 S @STORE@(DIV,TM,"TI",6)="" 83 I CUR+1>MAX S @STORE@(DIV,TM,"TI",7)="This team is not accepting patients." 84 I CUR<MAX,CUR'=MAX S @STORE@(DIV,TM,"TI",7)="This team is still accepting patients." 85 Q 86 ; 87 FORMAT(POS,PPC,MAX,DIV,TM,TPOS,ROL,CNAME,SCPROV,SCPTASS) ; 88 ; 89 I POS="" S POS="[BAD DATA]" 90 S @STORE@(DIV,TM,"P",POS)=$E(POS,1,24) ;position 91 S $E(@STORE@(DIV,TM,"P",POS),27)=$E(SCPROV,1,24) ;provider 92 S $E(@STORE@(DIV,TM,"P",POS),53)=$E(ROL,1,24) ;standard role 93 S $E(@STORE@(DIV,TM,"P",POS),77)=PPC ;primary care yes/no 94 S $E(@STORE@(DIV,TM,"P",POS),82)=$J(MAX,6,0) ;number of patients allowed 95 S $E(@STORE@(DIV,TM,"P",POS),92)=$J(SCPTASS,6,0) ;patients assigned 96 S $E(@STORE@(DIV,TM,"P",POS),103)=$E(CNAME,1,30) ;clinic name 97 Q 98 ; 99 FORHEAD ; 100 S @STORE@("C",2)="Team Position" 101 S $E(@STORE@("C",2),27)="Provider Name" 102 S $E(@STORE@("C",2),53)="Standard Role" 103 S $E(@STORE@("C",2),77)="PC?" 104 S $E(@STORE@("C",1),82)="Patients" 105 S $E(@STORE@("C",2),82)="Allowed" 106 S $E(@STORE@("C",1),92)="Patients" 107 S $E(@STORE@("C",2),92)="Assigned" 108 S $E(@STORE@("C",2),103)="Associated Clinic" 109 S $P(@STORE@("C",3),"=",133)="" 110 Q 111 ; 112 CONT ;Team continuation header 113 W !,"Team '",TNAME,"' continued..." 114 COLUMN ; 115 I STOP Q 116 N EN 117 S EN=0 118 F S EN=$O(@STORE@("C",EN)) Q:EN="" D 119 .W !,$G(@STORE@("C",EN)) 120 Q 121 ;
Note:
See TracChangeset
for help on using the changeset viewer.
