- SDPPTEM ;BP-CIOFO/KEITH - Patient Profile Team Info ; 8/27/99 10:39am
- ;;5.3;Scheduling;**41,177,297**;AUG 13, 1993
- ;
- ;Gathering Team Information for Patient Profile
- ;
- TDATA(DFN,VALMCNT,SDATE,SDPRT,SDCOL) ;Team information - gather, format and optionally print.
- ;Input: DFN=patient ifn
- ;Input: VALMCNT=variable to return number of lines (pass by reference)
- ;Input: SDATE=effective date (optional)
- ;Input: SDPRT=print flag, 'P' for PC info only, 'A' for all (optional)
- ;Input: SDCOL=column to print in conjunction with SDPRT flag (optional)
- ;
- Q:DFN'>0
- N SDI,SDATE,SDLIST,SDX,SDLN,SDY,SDPH,SDTEAM,SDPTA,SDII,SDIII,SDZ
- N SDTM,SDTMN,SDPO,SDPON,SDPR,SDPRN
- N PAGER,PHONE
- ;
- F SDI="SDPLIST","SDTEMP" K ^TMP(SDI,$J)
- S SDCOL=+$G(SDCOL),SDATE=$G(SDATE) S:SDATE<1 SDATE=DT
- F SDI="BEGIN","END" S SDATE(SDI)=SDATE
- S SDATE="SDATE",SDLIST="^TMP(""SDPLIST"",$J)",SDLN=2
- ;
- S SDI=$$GETALL^SCAPMCA(DFN,.SDATE,SDLIST)
- ;
- ;PC Team
- S SDI=0 F S SDI=$O(^TMP("SDPLIST",$J,DFN,"PCTM",SDI)) Q:'SDI D
- .S SDX=$G(^TMP("SDPLIST",$J,DFN,"PCTM",SDI)) Q:'$L(SDX)
- .S SDY=""
- .D S1("Primary Care Team",$P(SDX,U,2))
- .S SDPH=$P($G(^SCTM(404.51,+SDX,0)),U,2) D:$L(SDPH) S2("Phone",SDPH)
- .S:$P(SDX,U,3) SDPTA($P(SDX,U,3))=""
- .D STL(SDY)
- .Q
- ;
- ;AP
- S SDI=0 F S SDI=$O(^TMP("SDPLIST",$J,DFN,"PCAP",SDI)) Q:'SDI D
- .S SDX=$G(^TMP("SDPLIST",$J,DFN,"PCAP",SDI)) Q:'$L(SDX)
- .S SDY=""
- .D S1("Associate Provider",$P(SDX,U,2))
- .D S2("Position",$P(SDX,U,4))
- .D STL(SDY)
- .D PHONE($P(SDX,U,1))
- .S SDY=""
- .D S3("Pager",PAGER)
- .D S4("Phone",PHONE)
- .D STL(SDY)
- .Q
- ;PCP
- S SDI=0 F S SDI=$O(^TMP("SDPLIST",$J,DFN,"PCPR",SDI)) Q:'SDI D
- .S SDX=$G(^TMP("SDPLIST",$J,DFN,"PCPR",SDI)) Q:'$L(SDX)
- .S SDY=""
- .D S1("PC Provider",$P(SDX,U,2))
- .D S2("Position",$P(SDX,U,4))
- .D STL(SDY)
- .D PHONE($P(SDX,U,1))
- .S SDY=""
- .D S3("Pager",PAGER)
- .D S4("Phone",PHONE)
- .D STL(SDY)
- .Q
- ;
- I $G(SDPRT)="P" D PRT G TDQ
- S SDII=0
- F S SDII=$O(^TMP("SDPLIST",$J,DFN,"NPCPOS",SDII)) Q:'SDII D
- .S SDX=^TMP("SDPLIST",$J,DFN,"NPCPOS",SDII)
- .Q:'$D(SDPTA(+$P(SDX,U,11))) S SDIII=0
- .F S SDIII=$O(^TMP("SDPLIST",$J,DFN,"NPCPR",SDIII)) Q:'SDIII D
- ..S SDZ=^TMP("SDPLIST",$J,DFN,"NPCPR",SDIII)
- ..Q:$P(SDZ,U,3)'=+SDX S SDY=""
- ..D S1("Non-PC Provider",$P(SDZ,U,2)),S2("Position",$P(SDZ,U,4))
- ..D STL(SDY) Q
- .Q
- S SDI=0
- F S SDI=$O(^TMP("SDPLIST",$J,DFN,"NPCTM",SDI)) Q:'SDI D
- .S SDX=^TMP("SDPLIST",$J,DFN,"NPCTM",SDI)
- .S SDTEAM($P(SDX,U,2),+SDX)="",SDPTA=$P(SDX,U,3) Q:'SDPTA D
- ..S SDII=0
- ..F S SDII=$O(^TMP("SDPLIST",$J,DFN,"NPCPOS",SDII)) Q:'SDII D
- ...S SDY=^TMP("SDPLIST",$J,DFN,"NPCPOS",SDII)
- ...Q:$P(SDY,U,11)'=SDPTA
- ...S SDTEAM($P(SDX,U,2),+SDX,$P(SDY,U,2),+SDY)="",SDIII=0
- ...F S SDIII=$O(^TMP("SDPLIST",$J,DFN,"NPCPR",SDIII)) Q:'SDIII D
- ....S SDZ=^TMP("SDPLIST",$J,DFN,"NPCPR",SDIII)
- ....Q:$P(SDZ,U,3)'=+SDY
- ....S SDTEAM($P(SDX,U,2),+SDX,$P(SDY,U,2),+SDY,$P(SDZ,U,2),+SDZ)=""
- ....Q
- ...Q
- ..Q
- .Q
- S SDTM="" F S SDTM=$O(SDTEAM(SDTM)) Q:SDTM="" D
- .S SDTMN=0 F S SDTMN=$O(SDTEAM(SDTM,SDTMN)) Q:'SDTMN D
- ..I SDLN>0 D STL("")
- ..S SDY="" D S1("Non-PC Team",SDTM)
- ..S SDPH=$P($G(^SCTM(404.51,+SDTMN,0)),U,2) D:$L(SDPH) S2("Phone",SDPH)
- ..D STL(SDY) S SDPO=""
- ..F S SDPO=$O(SDTEAM(SDTM,SDTMN,SDPO)) Q:SDPO="" S SDPON=0 D
- ...F S SDPON=$O(SDTEAM(SDTM,SDTMN,SDPO,SDPON)) Q:'SDPON D
- ....I $O(SDTEAM(SDTM,SDTMN,SDPO,SDPON,""))="" S SDY="" D S1("Non-PC Provider",""),S2("Position",SDPO),STL(SDY) Q
- ....S SDPR=""
- ....F S SDPR=$O(SDTEAM(SDTM,SDTMN,SDPO,SDPON,SDPR)) Q:SDPR="" D
- .....S SDPRN=0
- .....F S SDPRN=$O(SDTEAM(SDTM,SDTMN,SDPO,SDPON,SDPR,SDPRN)) Q:'SDPRN D
- ......S SDY=""
- ......D S1("Non-PC Provider",SDPR)
- ......D S2("Position",SDPO)
- ......D STL(SDY)
- ......D PHONE(SDPRN)
- ......S SDY=""
- ......D S3("Pager",PAGER)
- ......D S4("Phone",PHONE)
- ......D STL(SDY)
- ......Q
- .....Q
- ....Q
- ...Q
- ..Q
- .Q
- ;
- I $G(SDPRT)="A" D PRT G TDQ
- S SDY="",$E(SDY,29)="*** Team Information ***"
- S ^TMP("SDTEMP",$J,1)=SDY,^TMP("SDTEMP",$J,2)=""
- I SDLN=2 S SDY="",$E(SDY,20)="-- No team assignment information found --",^TMP("SDTEMP",$J,3)=SDY
- S GBL=$G(GBL,"") I $L(GBL)<1 S GBL=$S('$D(VALMAR):"^TMP(""SDPP"",$J)",$L(VALMAR)>1:VALMAR,1:"^TMP(""SDPP"",$J)")
- ;add line at bottom of array for readability
- S SDI=$O(^TMP("SDTEMP",$J,""),-1)+1,^TMP("SDTEMP",$J,SDI)=""
- ;respect the array count passed in to the function
- S (SDII,VALMCNT)=$O(@GBL@(""),-1)+1
- S SDI=0
- F S SDI=$O(^TMP("SDTEMP",$J,SDI)) Q:'SDI D
- .S SDX=^TMP("SDTEMP",$J,SDI),SDII=SDII+1
- .S @GBL@(SDII,0)=SDX,VALMCNT=$G(VALMCNT)+1
- .I SDLN<7,SDI>3 S SDII=SDII+1,@GBL@(SDII,0)="",VALMCNT=$G(VALMCNT)+1
- .Q
- TDQ F SDI="SDPLIST","SDTEMP" K ^TMP(SDI,$J,DFN)
- Q
- ;
- S1(SDT,SDX) ;Set first piece of string
- ;Input: SDT=subtitle
- ;Input: SDX=data value
- S SDY=$J(SDT,18)_": "_$E(SDX,1,28) Q
- ;
- S2(SDT,SDX) ;Set second piece of string
- ;Input: SDT=subtitle
- ;Input: SDX=data value
- I $L($G(SDPRT)),SDCOL>0 Q
- S $E(SDY,53)=$J(SDT,8)_": "_$E(SDX,1,18) Q
- ;
- S3(SDT,SDX) ;Set first piece of string that displays phone numbers
- ;Input: SDT=subtitle
- ;Input: SDX=data value
- S SDY=$J(SDT,30)_": "_$E(SDX,1,20)
- Q
- ;
- S4(SDT,SDX) ;Set second piece of string that displays phone numbers
- ;Input: SDT=subtitle
- ;Input: SDX=data value
- I $L($G(SDPRT)),SDCOL>0 Q
- S $E(SDY,56)=$J(SDT,4)_": "_$E(SDX,1,20)
- Q
- ;
- PHONE(IEN) ;Get provider's pager and phone numbers.
- ;Return: PAGER = Pager number
- ; PHONE = Phone number
- NEW LIST
- S (PAGER,PHONE)=""
- Q:'$G(IEN)
- Q:'$$NEWPERSN^SCMCGU(IEN,"LIST")
- S PAGER=$P(LIST(IEN),U,5)
- S PHONE=$P(LIST(IEN),U,2)
- Q
- ;
- STL(SDY) ;Set text line
- ;Input: SDY=string
- S SDLN=SDLN+1
- S ^TMP("SDTEMP",$J,SDLN)=SDY
- Q
- ;
- PRT ;Write assignment information
- N SDI S SDI=0
- F S SDI=$O(^TMP("SDTEMP",$J,SDI)) Q:'SDI D
- .W !?(SDCOL),^TMP("SDTEMP",$J,SDI) Q
- Q
- ;
- PCLINE(DFN,SDATE) ;PC provider, associate and team in a single line
- ;Input: DFN=patient ifn
- ;Input: SDATE=effective date (optional)
- ;Output: PC provider, associate and team formatted as 80 character
- ; line, or "" if none
- ;
- N SDLIST,SDI,SDX,SDY,SDZ,SDL,SDC,SDTL
- Q:'DFN "" S:$G(SDATE)<1 SDATE=DT S SDLIST="^TMP(""SDPLIST"",$J)"
- F SDI="BEGIN","END" S SDATE(SDI)=SDATE
- S SDATE="SDATE"
- S SDI=$$GETALL^SCAPMCA(DFN,.SDATE,SDLIST)
- S SDY="PC Prov: ^Assoc. Prov: ^Team: ",SDL=48,SDC=3,SDTL=0
- S SDX(1)=$$PCL("PCPR")
- S SDX(2)=$$PCL("PCAP")
- S SDX(3)=$$PCL("PCTM")
- K ^TMP("SDPLIST",$J,DFN)
- F SDI=1,2,3 S SDZ($L(SDX(SDI)),SDI)=""
- S SDI="" F S SDI=$O(SDZ(SDI)) Q:SDI="" D
- .S SDII=0 F S SDII=$O(SDZ(SDI,SDII)) Q:'SDII D
- ..I 'SDI S SDC=SDC-1 Q
- ..I SDI<(SDL\SDC) S SDX(SDII)=$P(SDY,U,SDII)_SDX(SDII),SDL=SDL-SDI,SDC=SDC-1 Q
- ..S SDX(SDII)=$P(SDY,U,SDII)_$E(SDX(SDII),1,(SDL\SDC))
- ..Q
- .Q
- F SDI=1,2,3 S SDTL=SDTL+$L(SDX(SDI))
- Q:SDTL=0 ""
- S SDX=SDX(1),$E(SDX,($L(SDX)+1+(80-SDTL\2)))=SDX(2),$E(SDX,81-$L(SDX(3)))=SDX(3)
- Q SDX
- ;
- PCL(SDSUB) ;Get name value
- ;Input: SDSUB=node from GETALL^SCAPMCA
- N SDN
- S SDN=+$G(^TMP("SDPLIST",$J,DFN,"PCPOS",0))
- Q:SDN=0 ""
- Q:SDN>1 "[ambiguous data]"
- S SDN=+$G(^TMP("SDPLIST",$J,DFN,SDSUB,0))
- Q:SDN=0 ""
- Q:SDN>1 "[ambiguous data]"
- Q $P($G(^TMP("SDPLIST",$J,DFN,SDSUB,1)),U,2)
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDPPTEM 7302 printed Jan 18, 2025@04:01:01 Page 2
- SDPPTEM ;BP-CIOFO/KEITH - Patient Profile Team Info ; 8/27/99 10:39am
- +1 ;;5.3;Scheduling;**41,177,297**;AUG 13, 1993
- +2 ;
- +3 ;Gathering Team Information for Patient Profile
- +4 ;
- TDATA(DFN,VALMCNT,SDATE,SDPRT,SDCOL) ;Team information - gather, format and optionally print.
- +1 ;Input: DFN=patient ifn
- +2 ;Input: VALMCNT=variable to return number of lines (pass by reference)
- +3 ;Input: SDATE=effective date (optional)
- +4 ;Input: SDPRT=print flag, 'P' for PC info only, 'A' for all (optional)
- +5 ;Input: SDCOL=column to print in conjunction with SDPRT flag (optional)
- +6 ;
- +7 if DFN'>0
- QUIT
- +8 NEW SDI,SDATE,SDLIST,SDX,SDLN,SDY,SDPH,SDTEAM,SDPTA,SDII,SDIII,SDZ
- +9 NEW SDTM,SDTMN,SDPO,SDPON,SDPR,SDPRN
- +10 NEW PAGER,PHONE
- +11 ;
- +12 FOR SDI="SDPLIST","SDTEMP"
- KILL ^TMP(SDI,$JOB)
- +13 SET SDCOL=+$GET(SDCOL)
- SET SDATE=$GET(SDATE)
- if SDATE<1
- SET SDATE=DT
- +14 FOR SDI="BEGIN","END"
- SET SDATE(SDI)=SDATE
- +15 SET SDATE="SDATE"
- SET SDLIST="^TMP(""SDPLIST"",$J)"
- SET SDLN=2
- +16 ;
- +17 SET SDI=$$GETALL^SCAPMCA(DFN,.SDATE,SDLIST)
- +18 ;
- +19 ;PC Team
- +20 SET SDI=0
- FOR
- SET SDI=$ORDER(^TMP("SDPLIST",$JOB,DFN,"PCTM",SDI))
- if 'SDI
- QUIT
- Begin DoDot:1
- +21 SET SDX=$GET(^TMP("SDPLIST",$JOB,DFN,"PCTM",SDI))
- if '$LENGTH(SDX)
- QUIT
- +22 SET SDY=""
- +23 DO S1("Primary Care Team",$PIECE(SDX,U,2))
- +24 SET SDPH=$PIECE($GET(^SCTM(404.51,+SDX,0)),U,2)
- if $LENGTH(SDPH)
- DO S2("Phone",SDPH)
- +25 if $PIECE(SDX,U,3)
- SET SDPTA($PIECE(SDX,U,3))=""
- +26 DO STL(SDY)
- +27 QUIT
- End DoDot:1
- +28 ;
- +29 ;AP
- +30 SET SDI=0
- FOR
- SET SDI=$ORDER(^TMP("SDPLIST",$JOB,DFN,"PCAP",SDI))
- if 'SDI
- QUIT
- Begin DoDot:1
- +31 SET SDX=$GET(^TMP("SDPLIST",$JOB,DFN,"PCAP",SDI))
- if '$LENGTH(SDX)
- QUIT
- +32 SET SDY=""
- +33 DO S1("Associate Provider",$PIECE(SDX,U,2))
- +34 DO S2("Position",$PIECE(SDX,U,4))
- +35 DO STL(SDY)
- +36 DO PHONE($PIECE(SDX,U,1))
- +37 SET SDY=""
- +38 DO S3("Pager",PAGER)
- +39 DO S4("Phone",PHONE)
- +40 DO STL(SDY)
- +41 QUIT
- End DoDot:1
- +42 ;PCP
- +43 SET SDI=0
- FOR
- SET SDI=$ORDER(^TMP("SDPLIST",$JOB,DFN,"PCPR",SDI))
- if 'SDI
- QUIT
- Begin DoDot:1
- +44 SET SDX=$GET(^TMP("SDPLIST",$JOB,DFN,"PCPR",SDI))
- if '$LENGTH(SDX)
- QUIT
- +45 SET SDY=""
- +46 DO S1("PC Provider",$PIECE(SDX,U,2))
- +47 DO S2("Position",$PIECE(SDX,U,4))
- +48 DO STL(SDY)
- +49 DO PHONE($PIECE(SDX,U,1))
- +50 SET SDY=""
- +51 DO S3("Pager",PAGER)
- +52 DO S4("Phone",PHONE)
- +53 DO STL(SDY)
- +54 QUIT
- End DoDot:1
- +55 ;
- +56 IF $GET(SDPRT)="P"
- DO PRT
- GOTO TDQ
- +57 SET SDII=0
- +58 FOR
- SET SDII=$ORDER(^TMP("SDPLIST",$JOB,DFN,"NPCPOS",SDII))
- if 'SDII
- QUIT
- Begin DoDot:1
- +59 SET SDX=^TMP("SDPLIST",$JOB,DFN,"NPCPOS",SDII)
- +60 if '$DATA(SDPTA(+$PIECE(SDX,U,11)))
- QUIT
- SET SDIII=0
- +61 FOR
- SET SDIII=$ORDER(^TMP("SDPLIST",$JOB,DFN,"NPCPR",SDIII))
- if 'SDIII
- QUIT
- Begin DoDot:2
- +62 SET SDZ=^TMP("SDPLIST",$JOB,DFN,"NPCPR",SDIII)
- +63 if $PIECE(SDZ,U,3)'=+SDX
- QUIT
- SET SDY=""
- +64 DO S1("Non-PC Provider",$PIECE(SDZ,U,2))
- DO S2("Position",$PIECE(SDZ,U,4))
- +65 DO STL(SDY)
- QUIT
- End DoDot:2
- +66 QUIT
- End DoDot:1
- +67 SET SDI=0
- +68 FOR
- SET SDI=$ORDER(^TMP("SDPLIST",$JOB,DFN,"NPCTM",SDI))
- if 'SDI
- QUIT
- Begin DoDot:1
- +69 SET SDX=^TMP("SDPLIST",$JOB,DFN,"NPCTM",SDI)
- +70 SET SDTEAM($PIECE(SDX,U,2),+SDX)=""
- SET SDPTA=$PIECE(SDX,U,3)
- if 'SDPTA
- QUIT
- Begin DoDot:2
- +71 SET SDII=0
- +72 FOR
- SET SDII=$ORDER(^TMP("SDPLIST",$JOB,DFN,"NPCPOS",SDII))
- if 'SDII
- QUIT
- Begin DoDot:3
- +73 SET SDY=^TMP("SDPLIST",$JOB,DFN,"NPCPOS",SDII)
- +74 if $PIECE(SDY,U,11)'=SDPTA
- QUIT
- +75 SET SDTEAM($PIECE(SDX,U,2),+SDX,$PIECE(SDY,U,2),+SDY)=""
- SET SDIII=0
- +76 FOR
- SET SDIII=$ORDER(^TMP("SDPLIST",$JOB,DFN,"NPCPR",SDIII))
- if 'SDIII
- QUIT
- Begin DoDot:4
- +77 SET SDZ=^TMP("SDPLIST",$JOB,DFN,"NPCPR",SDIII)
- +78 if $PIECE(SDZ,U,3)'=+SDY
- QUIT
- +79 SET SDTEAM($PIECE(SDX,U,2),+SDX,$PIECE(SDY,U,2),+SDY,$PIECE(SDZ,U,2),+SDZ)=""
- +80 QUIT
- End DoDot:4
- +81 QUIT
- End DoDot:3
- +82 QUIT
- End DoDot:2
- +83 QUIT
- End DoDot:1
- +84 SET SDTM=""
- FOR
- SET SDTM=$ORDER(SDTEAM(SDTM))
- if SDTM=""
- QUIT
- Begin DoDot:1
- +85 SET SDTMN=0
- FOR
- SET SDTMN=$ORDER(SDTEAM(SDTM,SDTMN))
- if 'SDTMN
- QUIT
- Begin DoDot:2
- +86 IF SDLN>0
- DO STL("")
- +87 SET SDY=""
- DO S1("Non-PC Team",SDTM)
- +88 SET SDPH=$PIECE($GET(^SCTM(404.51,+SDTMN,0)),U,2)
- if $LENGTH(SDPH)
- DO S2("Phone",SDPH)
- +89 DO STL(SDY)
- SET SDPO=""
- +90 FOR
- SET SDPO=$ORDER(SDTEAM(SDTM,SDTMN,SDPO))
- if SDPO=""
- QUIT
- SET SDPON=0
- Begin DoDot:3
- +91 FOR
- SET SDPON=$ORDER(SDTEAM(SDTM,SDTMN,SDPO,SDPON))
- if 'SDPON
- QUIT
- Begin DoDot:4
- +92 IF $ORDER(SDTEAM(SDTM,SDTMN,SDPO,SDPON,""))=""
- SET SDY=""
- DO S1("Non-PC Provider","")
- DO S2("Position",SDPO)
- DO STL(SDY)
- QUIT
- +93 SET SDPR=""
- +94 FOR
- SET SDPR=$ORDER(SDTEAM(SDTM,SDTMN,SDPO,SDPON,SDPR))
- if SDPR=""
- QUIT
- Begin DoDot:5
- +95 SET SDPRN=0
- +96 FOR
- SET SDPRN=$ORDER(SDTEAM(SDTM,SDTMN,SDPO,SDPON,SDPR,SDPRN))
- if 'SDPRN
- QUIT
- Begin DoDot:6
- +97 SET SDY=""
- +98 DO S1("Non-PC Provider",SDPR)
- +99 DO S2("Position",SDPO)
- +100 DO STL(SDY)
- +101 DO PHONE(SDPRN)
- +102 SET SDY=""
- +103 DO S3("Pager",PAGER)
- +104 DO S4("Phone",PHONE)
- +105 DO STL(SDY)
- +106 QUIT
- End DoDot:6
- +107 QUIT
- End DoDot:5
- +108 QUIT
- End DoDot:4
- +109 QUIT
- End DoDot:3
- +110 QUIT
- End DoDot:2
- +111 QUIT
- End DoDot:1
- +112 ;
- +113 IF $GET(SDPRT)="A"
- DO PRT
- GOTO TDQ
- +114 SET SDY=""
- SET $EXTRACT(SDY,29)="*** Team Information ***"
- +115 SET ^TMP("SDTEMP",$JOB,1)=SDY
- SET ^TMP("SDTEMP",$JOB,2)=""
- +116 IF SDLN=2
- SET SDY=""
- SET $EXTRACT(SDY,20)="-- No team assignment information found --"
- SET ^TMP("SDTEMP",$JOB,3)=SDY
- +117 SET GBL=$GET(GBL,"")
- IF $LENGTH(GBL)<1
- SET GBL=$SELECT('$DATA(VALMAR):"^TMP(""SDPP"",$J)",$LENGTH(VALMAR)>1:VALMAR,1:"^TMP(""SDPP"",$J)")
- +118 ;add line at bottom of array for readability
- +119 SET SDI=$ORDER(^TMP("SDTEMP",$JOB,""),-1)+1
- SET ^TMP("SDTEMP",$JOB,SDI)=""
- +120 ;respect the array count passed in to the function
- +121 SET (SDII,VALMCNT)=$ORDER(@GBL@(""),-1)+1
- +122 SET SDI=0
- +123 FOR
- SET SDI=$ORDER(^TMP("SDTEMP",$JOB,SDI))
- if 'SDI
- QUIT
- Begin DoDot:1
- +124 SET SDX=^TMP("SDTEMP",$JOB,SDI)
- SET SDII=SDII+1
- +125 SET @GBL@(SDII,0)=SDX
- SET VALMCNT=$GET(VALMCNT)+1
- +126 IF SDLN<7
- IF SDI>3
- SET SDII=SDII+1
- SET @GBL@(SDII,0)=""
- SET VALMCNT=$GET(VALMCNT)+1
- +127 QUIT
- End DoDot:1
- TDQ FOR SDI="SDPLIST","SDTEMP"
- KILL ^TMP(SDI,$JOB,DFN)
- +1 QUIT
- +2 ;
- S1(SDT,SDX) ;Set first piece of string
- +1 ;Input: SDT=subtitle
- +2 ;Input: SDX=data value
- +3 SET SDY=$JUSTIFY(SDT,18)_": "_$EXTRACT(SDX,1,28)
- QUIT
- +4 ;
- S2(SDT,SDX) ;Set second piece of string
- +1 ;Input: SDT=subtitle
- +2 ;Input: SDX=data value
- +3 IF $LENGTH($GET(SDPRT))
- IF SDCOL>0
- QUIT
- +4 SET $EXTRACT(SDY,53)=$JUSTIFY(SDT,8)_": "_$EXTRACT(SDX,1,18)
- QUIT
- +5 ;
- S3(SDT,SDX) ;Set first piece of string that displays phone numbers
- +1 ;Input: SDT=subtitle
- +2 ;Input: SDX=data value
- +3 SET SDY=$JUSTIFY(SDT,30)_": "_$EXTRACT(SDX,1,20)
- +4 QUIT
- +5 ;
- S4(SDT,SDX) ;Set second piece of string that displays phone numbers
- +1 ;Input: SDT=subtitle
- +2 ;Input: SDX=data value
- +3 IF $LENGTH($GET(SDPRT))
- IF SDCOL>0
- QUIT
- +4 SET $EXTRACT(SDY,56)=$JUSTIFY(SDT,4)_": "_$EXTRACT(SDX,1,20)
- +5 QUIT
- +6 ;
- PHONE(IEN) ;Get provider's pager and phone numbers.
- +1 ;Return: PAGER = Pager number
- +2 ; PHONE = Phone number
- +3 NEW LIST
- +4 SET (PAGER,PHONE)=""
- +5 if '$GET(IEN)
- QUIT
- +6 if '$$NEWPERSN^SCMCGU(IEN,"LIST")
- QUIT
- +7 SET PAGER=$PIECE(LIST(IEN),U,5)
- +8 SET PHONE=$PIECE(LIST(IEN),U,2)
- +9 QUIT
- +10 ;
- STL(SDY) ;Set text line
- +1 ;Input: SDY=string
- +2 SET SDLN=SDLN+1
- +3 SET ^TMP("SDTEMP",$JOB,SDLN)=SDY
- +4 QUIT
- +5 ;
- PRT ;Write assignment information
- +1 NEW SDI
- SET SDI=0
- +2 FOR
- SET SDI=$ORDER(^TMP("SDTEMP",$JOB,SDI))
- if 'SDI
- QUIT
- Begin DoDot:1
- +3 WRITE !?(SDCOL),^TMP("SDTEMP",$JOB,SDI)
- QUIT
- End DoDot:1
- +4 QUIT
- +5 ;
- PCLINE(DFN,SDATE) ;PC provider, associate and team in a single line
- +1 ;Input: DFN=patient ifn
- +2 ;Input: SDATE=effective date (optional)
- +3 ;Output: PC provider, associate and team formatted as 80 character
- +4 ; line, or "" if none
- +5 ;
- +6 NEW SDLIST,SDI,SDX,SDY,SDZ,SDL,SDC,SDTL
- +7 if 'DFN
- QUIT ""
- if $GET(SDATE)<1
- SET SDATE=DT
- SET SDLIST="^TMP(""SDPLIST"",$J)"
- +8 FOR SDI="BEGIN","END"
- SET SDATE(SDI)=SDATE
- +9 SET SDATE="SDATE"
- +10 SET SDI=$$GETALL^SCAPMCA(DFN,.SDATE,SDLIST)
- +11 SET SDY="PC Prov: ^Assoc. Prov: ^Team: "
- SET SDL=48
- SET SDC=3
- SET SDTL=0
- +12 SET SDX(1)=$$PCL("PCPR")
- +13 SET SDX(2)=$$PCL("PCAP")
- +14 SET SDX(3)=$$PCL("PCTM")
- +15 KILL ^TMP("SDPLIST",$JOB,DFN)
- +16 FOR SDI=1,2,3
- SET SDZ($LENGTH(SDX(SDI)),SDI)=""
- +17 SET SDI=""
- FOR
- SET SDI=$ORDER(SDZ(SDI))
- if SDI=""
- QUIT
- Begin DoDot:1
- +18 SET SDII=0
- FOR
- SET SDII=$ORDER(SDZ(SDI,SDII))
- if 'SDII
- QUIT
- Begin DoDot:2
- +19 IF 'SDI
- SET SDC=SDC-1
- QUIT
- +20 IF SDI<(SDL\SDC)
- SET SDX(SDII)=$PIECE(SDY,U,SDII)_SDX(SDII)
- SET SDL=SDL-SDI
- SET SDC=SDC-1
- QUIT
- +21 SET SDX(SDII)=$PIECE(SDY,U,SDII)_$EXTRACT(SDX(SDII),1,(SDL\SDC))
- +22 QUIT
- End DoDot:2
- +23 QUIT
- End DoDot:1
- +24 FOR SDI=1,2,3
- SET SDTL=SDTL+$LENGTH(SDX(SDI))
- +25 if SDTL=0
- QUIT ""
- +26 SET SDX=SDX(1)
- SET $EXTRACT(SDX,($LENGTH(SDX)+1+(80-SDTL\2)))=SDX(2)
- SET $EXTRACT(SDX,81-$LENGTH(SDX(3)))=SDX(3)
- +27 QUIT SDX
- +28 ;
- PCL(SDSUB) ;Get name value
- +1 ;Input: SDSUB=node from GETALL^SCAPMCA
- +2 NEW SDN
- +3 SET SDN=+$GET(^TMP("SDPLIST",$JOB,DFN,"PCPOS",0))
- +4 if SDN=0
- QUIT ""
- +5 if SDN>1
- QUIT "[ambiguous data]"
- +6 SET SDN=+$GET(^TMP("SDPLIST",$JOB,DFN,SDSUB,0))
- +7 if SDN=0
- QUIT ""
- +8 if SDN>1
- QUIT "[ambiguous data]"
- +9 QUIT $PIECE($GET(^TMP("SDPLIST",$JOB,DFN,SDSUB,1)),U,2)