SCRPPAT2 ;ALB/CMM - Practitioner's Patients ; 12/12/00 3:46pm
;;5.3;Scheduling;**41,48,174,181,177,231,433,297,526,520**;AUG 13, 1993;Build 26
;
;Listing of Practitioner's Patients
;
DRIVE ;
;driver module
N PRAC,INF,ARRY,ERROR,NXT,OKAY,PIEN,TPRC
S ARRY="^TMP(""SCARRAY"","_$J_")",ERROR="ERR"
S TPRC="^TMP(""SCRP"",$J,""PRACT"")" M @TPRC=PRACT
K @ARRY,@ERROR,PRACT
I @TPRC=1 D ALL^SCRPPAT3 ;all practitioners selected
S NXT=0
F S NXT=$O(@TPRC@(NXT)) Q:NXT=""!(NXT'?.N) D
.I @TPRC=0 S PIEN=NXT
.I @TPRC=1 S PIEN=$P(@TPRC@(NXT),"^")
.K @ARRY,@ERROR
.S OKAY=$$PTPR^SCAPMC14(PIEN,"","","",ARRY,ERROR) ;patients for practitioner
.I '+OKAY Q
.D LOOPPT(ARRY,PIEN) ;loop through patients for practitioner
K @ARRY,@ERROR,@TPRC
K:SUMM @STORE@("PT")
Q
;
LOOPPT(ARY,PRAC) ;loop through patients for practitioner
;ARY - array of patients for selected practitioner
;PRAC - practitioner ien
N NXT,PIEN,TPIEN,PNAME,TPIEN,NODE,PTP,TPI,TPN,CLIEN,PTA,PTAN,TIEN
N PC,TNODE,TNAME,PINF,POSN,PRCP,CNAME
S NXT=0
F S NXT=$O(@ARY@(NXT)) Q:NXT=""!(NXT'?.N) D
.S NODE=$G(@ARY@(NXT))
.Q:NODE=""
.S PIEN=+$P(NODE,"^") ;ien of patient file entry
.S TPIEN=+$P(NODE,"^",3) ;ien of patient team position assignment
.S PTP=$G(^SCPT(404.43,TPIEN,0))
.Q:PTP=""
.S PTA=+$P(PTP,"^") ;patient team assignment ien (404.42)
.S PTAN=$G(^SCPT(404.42,PTA,0))
.Q:PTAN=""
.S TIEN=+$P(PTAN,"^",3) ;team file ien (404.51)
.I $G(TEAM)'=1,'$D(TEAM(TIEN)) Q ;not a selected team
.S TNODE=$G(^SCTM(404.51,TIEN,0))
.Q:TNODE="" I $G(INST)'=1,'$D(INST(+$P(TNODE,U,7))) Q
.S TNAME=$P(TNODE,"^") ;team name
.S TPI=+$P(PTP,"^",2) ;Team Position file ien (404.57)
.S TPN=$G(^SCTM(404.57,TPI,0))
.Q:TPN=""
.I $G(ROLE)'=1,'$D(ROLE(+$P(TPN,U,3))) Q ;not a selected role
.S POSN=$P(TPN,"^") ;position name
.D SETASCL^SCRPRAC2(TPI,.CNAME,.CLIEN) ;get clinics from multiple
.;S CLIEN=+$P(TPN,"^",9) ;associated clinic ien
.;commented next line off - clinic enrollment no longer needed SD*5.3*433
.;D CECHK(CLIEN,.CNAME,PIEN) ;is patient enrolled in associated clinic?
.;S CNAME=$P($G(^SC(CLIEN,0)),"^") ; SD*5.3*433 remove enroll check
.S PC=$S($P(PTP,"^",5)=0:0,1:1) ;primary care position 1or2-yes/0-no
.S PNAME=$P($G(^VA(200,+PRAC,0)),"^") ;practitioner name
.Q:PNAME=""
.S PRCP=$P($$OKPREC2^SCMCLK(TPI,DT),U,2)
.D GETPINF(PIEN,.CLIEN,.PINF) ;get patient information and appointments
.S CNAME=$G(CNAME(0)) ;first line will capture position information
.S PINF=$G(PINF(0))
.I PINF="" D
..S PINF=PIEN_"^"_$$PDATA^SCRPEC(PIEN,CNAME,CNAME,1)
.D FORMAT(CNAME,PINF,PC,TIEN,TNAME,PRAC,PNAME,POSN,TPI,PRCP)
.D SETFORM(PIEN,.CNAME,.PINF)
SETFORM(PIEN,CNAME,PINF) ;Format for clinic info only for multiples
N SCCNT
S SCCNT=0 F S SCCNT=$O(PINF(SCCNT)) Q:SCCNT="" D FORMATAC(CNAME(SCCNT),PINF(SCCNT),PC,TIEN,TNAME,PRAC,PNAME,POSN,TPI,PRCP)
Q
GETPINF(PIEN,CLIEN,PINF) ;get patient info
N SCCNT
S SCCNT="" F S SCCNT=$O(CLIEN(SCCNT)) Q:SCCNT="" D
.S PINF(SCCNT)=PIEN_"^"_$$PDATA^SCRPEC(PIEN,CLIEN(SCCNT),CNAME(SCCNT),1)
Q
;
CECHK(CLIEN,CNAME,PIEN) ;should no longer be used as of patch SD*5.3*433
;CLIEN - clinic ien
;CNAME - clinic name returned if patient is enrolled in clien clinic
;PIEN - patien ien
;
N EN,NODE
S CNAME=""
I $D(^DPT(PIEN,"DE","B",CLIEN)) D
.;enrolled at one time, check if discharged
.S EN=$O(^DPT(PIEN,"DE","B",CLIEN,""))
.S NODE=$G(^DPT(PIEN,"DE",EN,0))
.Q:NODE=""
.I $P(NODE,"^",3)="" S CNAME=$P($G(^SC(CLIEN,0)),"^") ;clinic name
.I $P(NODE,"^",3)'="",$P(NODE,"^",3)>DT S CNAME=$P($G(^SC(CLIEN,0)),"^") ;clinic name
Q
;
FORMAT(CNAME,PINF,PC,TIEN,TNAME,PRAC,PNAME,POSN,TPI,PRCP) ; format data for display
;CNAME - clinic name
;PINF - patient/clinic data
;PC - primary care 1/0
;TIEN - team file ien (#404.51)
;TNAME - team name
;PRAC - practitioner ien (#200)
;PNAME - practitioner name
;POSN - position name
;TPI - team position ien (#404.57)
;PRCP - preceptor name
;
N IIEN,INAME,ERR
S ERR=$$SETUP^SCRPPAT3(.IIEN,.INAME,TIEN,TNAME,PRAC,PNAME,POSN,TPI,PRCP)
I ERR Q
;
I SORT=1 D STOR(IIEN,TIEN,PRAC,PINF,PNAME,TNAME,TPI) ;sort division,team,practitioner
I SORT=2 D STOR(IIEN,PRAC,TIEN,PINF,PNAME,TNAME,TPI) ;sort division,practitioner,team
I SORT=3 D STOR(1,PRAC,1,PINF,PNAME,"T3",TPI)
Q
;
FORMATAC(CNAME,PINF,PC,TIEN,TNAME,PRAC,PNAME,POSN,TPI,PRCP) ; format data for display
;CNAME - clinic name
;PINF - patient/clinic data
;PC - primary care 1/0
;TIEN - team file ien (#404.51)
;TNAME - team name
;PRAC - practitioner ien (#200)
;PNAME - practitioner name
;POSN - position name
;TPI - team position ien (#404.57)
;PRCP - preceptor name
;
N IIEN,INAME,ERR
S ERR=$$SETUP^SCRPPAT3(.IIEN,.INAME,TIEN,TNAME,PRAC,PNAME,POSN,TPI,PRCP)
I ERR Q
;
I SORT=1 D STORA(IIEN,TIEN,PRAC,PINF,PNAME,TNAME,TPI,SCCNT) ;sort division,team,practitioner
I SORT=2 D STORA(IIEN,PRAC,TIEN,PINF,PNAME,TNAME,TPI,SCCNT) ;sort division,practitioner,team
I SORT=3 D STORA(1,PRAC,1,PINF,PNAME,"T3",TPI,SCCNT)
Q
;
STOR(IIEN,SEC,TRD,PINF,PNAME,TNAME,TPI,SCCNT) ;
;IIEN - ien institution
;SEC - second sort subscript, IEN team or IEN practitioner
;TRD - third sort subscript, IEN team or IEN practitioner
;PINF - patient/clinic info
;PNAME - practitioner name
;TNAME - team name
;TPI - team position ien
;
N PIEN,PTNAME,PID
S PIEN=+$P(PINF,"^") ;patient ien
S PTNAME=$E($P(PINF,"^",2),1,10) ;patient name
Q:$D(@STORE@("PT",IIEN,SEC,TRD,TPI,PTNAME,PIEN))
S @STORE@("PT",IIEN,SEC,TRD,TPI,PTNAME,PIEN)=""
I 'SUMM,'$D(@STORE@("PTOT",IIEN,SEC,TRD,PIEN)) D
.;count each unique patient for any given practitioner for grand total
.S @STORE@("PTOT",IIEN,SEC,TRD,PIEN)=""
.S @STORE@("TOTAL",IIEN,PRAC,0)=$G(@STORE@("TOTAL",IIEN,PRAC,0))+1 ;patient count by practitioner
;
S @STORE@("TOTAL",IIEN,PRAC,$S(SORT=3:1,1:TIEN),TPI)=$G(@STORE@("TOTAL",IIEN,PRAC,$S(SORT=3:1,1:TIEN),TPI))+1 ;patient count by practitioner and team
Q:SUMM
;
S @STORE@(IIEN,SEC,TRD,TPI,PIEN)=PTNAME
S PID=$P(PINF,"^",3),PID=$TR(PID,"-","")
S $E(@STORE@(IIEN,SEC,TRD,TPI,PIEN),13)=PID ;ssn
S $E(@STORE@(IIEN,SEC,TRD,TPI,PIEN),25)=$P(PINF,"^",4) ;means test status
S $E(@STORE@(IIEN,SEC,TRD,TPI,PIEN),31)=$P(PINF,"^",5) ;eligibility
;Removed by patch 174
;S $E(@STORE@(IIEN,SEC,TRD,TPI,PIEN),40)=$P(PINF,"^",6) ;patient status
S $E(@STORE@(IIEN,SEC,TRD,TPI,PIEN),42)=$P(PINF,"^",8) ;last appt
S $E(@STORE@(IIEN,SEC,TRD,TPI,PIEN),54)=$P(PINF,"^",9) ;nxt appt
S $E(@STORE@(IIEN,SEC,TRD,TPI,PIEN),66)=$E(CNAME,1,15) ;clinic
Q
STORA(IIEN,SEC,TRD,PINF,PNAME,TNAME,TPI,SCCNT) ;
I '$D(@STORE@(IIEN,SEC,TRD,TPI,PIEN,SCCNT)) D
.S $E(@STORE@(IIEN,SEC,TRD,TPI,PIEN,SCCNT),42)=$P(PINF,"^",8) ;last appt
.S $E(@STORE@(IIEN,SEC,TRD,TPI,PIEN,SCCNT),54)=$P(PINF,"^",9) ;nxt appt
.S $E(@STORE@(IIEN,SEC,TRD,TPI,PIEN,SCCNT),66)=$E(CNAME,1,15) ;clinic
.Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCRPPAT2 6975 printed Oct 16, 2024@18:43:25 Page 2
SCRPPAT2 ;ALB/CMM - Practitioner's Patients ; 12/12/00 3:46pm
+1 ;;5.3;Scheduling;**41,48,174,181,177,231,433,297,526,520**;AUG 13, 1993;Build 26
+2 ;
+3 ;Listing of Practitioner's Patients
+4 ;
DRIVE ;
+1 ;driver module
+2 NEW PRAC,INF,ARRY,ERROR,NXT,OKAY,PIEN,TPRC
+3 SET ARRY="^TMP(""SCARRAY"","_$JOB_")"
SET ERROR="ERR"
+4 SET TPRC="^TMP(""SCRP"",$J,""PRACT"")"
MERGE @TPRC=PRACT
+5 KILL @ARRY,@ERROR,PRACT
+6 ;all practitioners selected
IF @TPRC=1
DO ALL^SCRPPAT3
+7 SET NXT=0
+8 FOR
SET NXT=$ORDER(@TPRC@(NXT))
if NXT=""!(NXT'?.N)
QUIT
Begin DoDot:1
+9 IF @TPRC=0
SET PIEN=NXT
+10 IF @TPRC=1
SET PIEN=$PIECE(@TPRC@(NXT),"^")
+11 KILL @ARRY,@ERROR
+12 ;patients for practitioner
SET OKAY=$$PTPR^SCAPMC14(PIEN,"","","",ARRY,ERROR)
+13 IF '+OKAY
QUIT
+14 ;loop through patients for practitioner
DO LOOPPT(ARRY,PIEN)
End DoDot:1
+15 KILL @ARRY,@ERROR,@TPRC
+16 if SUMM
KILL @STORE@("PT")
+17 QUIT
+18 ;
LOOPPT(ARY,PRAC) ;loop through patients for practitioner
+1 ;ARY - array of patients for selected practitioner
+2 ;PRAC - practitioner ien
+3 NEW NXT,PIEN,TPIEN,PNAME,TPIEN,NODE,PTP,TPI,TPN,CLIEN,PTA,PTAN,TIEN
+4 NEW PC,TNODE,TNAME,PINF,POSN,PRCP,CNAME
+5 SET NXT=0
+6 FOR
SET NXT=$ORDER(@ARY@(NXT))
if NXT=""!(NXT'?.N)
QUIT
Begin DoDot:1
+7 SET NODE=$GET(@ARY@(NXT))
+8 if NODE=""
QUIT
+9 ;ien of patient file entry
SET PIEN=+$PIECE(NODE,"^")
+10 ;ien of patient team position assignment
SET TPIEN=+$PIECE(NODE,"^",3)
+11 SET PTP=$GET(^SCPT(404.43,TPIEN,0))
+12 if PTP=""
QUIT
+13 ;patient team assignment ien (404.42)
SET PTA=+$PIECE(PTP,"^")
+14 SET PTAN=$GET(^SCPT(404.42,PTA,0))
+15 if PTAN=""
QUIT
+16 ;team file ien (404.51)
SET TIEN=+$PIECE(PTAN,"^",3)
+17 ;not a selected team
IF $GET(TEAM)'=1
IF '$DATA(TEAM(TIEN))
QUIT
+18 SET TNODE=$GET(^SCTM(404.51,TIEN,0))
+19 if TNODE=""
QUIT
IF $GET(INST)'=1
IF '$DATA(INST(+$PIECE(TNODE,U,7)))
QUIT
+20 ;team name
SET TNAME=$PIECE(TNODE,"^")
+21 ;Team Position file ien (404.57)
SET TPI=+$PIECE(PTP,"^",2)
+22 SET TPN=$GET(^SCTM(404.57,TPI,0))
+23 if TPN=""
QUIT
+24 ;not a selected role
IF $GET(ROLE)'=1
IF '$DATA(ROLE(+$PIECE(TPN,U,3)))
QUIT
+25 ;position name
SET POSN=$PIECE(TPN,"^")
+26 ;get clinics from multiple
DO SETASCL^SCRPRAC2(TPI,.CNAME,.CLIEN)
+27 ;S CLIEN=+$P(TPN,"^",9) ;associated clinic ien
+28 ;commented next line off - clinic enrollment no longer needed SD*5.3*433
+29 ;D CECHK(CLIEN,.CNAME,PIEN) ;is patient enrolled in associated clinic?
+30 ;S CNAME=$P($G(^SC(CLIEN,0)),"^") ; SD*5.3*433 remove enroll check
+31 ;primary care position 1or2-yes/0-no
SET PC=$SELECT($PIECE(PTP,"^",5)=0:0,1:1)
+32 ;practitioner name
SET PNAME=$PIECE($GET(^VA(200,+PRAC,0)),"^")
+33 if PNAME=""
QUIT
+34 SET PRCP=$PIECE($$OKPREC2^SCMCLK(TPI,DT),U,2)
+35 ;get patient information and appointments
DO GETPINF(PIEN,.CLIEN,.PINF)
+36 ;first line will capture position information
SET CNAME=$GET(CNAME(0))
+37 SET PINF=$GET(PINF(0))
+38 IF PINF=""
Begin DoDot:2
+39 SET PINF=PIEN_"^"_$$PDATA^SCRPEC(PIEN,CNAME,CNAME,1)
End DoDot:2
+40 DO FORMAT(CNAME,PINF,PC,TIEN,TNAME,PRAC,PNAME,POSN,TPI,PRCP)
+41 DO SETFORM(PIEN,.CNAME,.PINF)
End DoDot:1
SETFORM(PIEN,CNAME,PINF) ;Format for clinic info only for multiples
+1 NEW SCCNT
+2 SET SCCNT=0
FOR
SET SCCNT=$ORDER(PINF(SCCNT))
if SCCNT=""
QUIT
DO FORMATAC(CNAME(SCCNT),PINF(SCCNT),PC,TIEN,TNAME,PRAC,PNAME,POSN,TPI,PRCP)
+3 QUIT
GETPINF(PIEN,CLIEN,PINF) ;get patient info
+1 NEW SCCNT
+2 SET SCCNT=""
FOR
SET SCCNT=$ORDER(CLIEN(SCCNT))
if SCCNT=""
QUIT
Begin DoDot:1
+3 SET PINF(SCCNT)=PIEN_"^"_$$PDATA^SCRPEC(PIEN,CLIEN(SCCNT),CNAME(SCCNT),1)
End DoDot:1
+4 QUIT
+5 ;
CECHK(CLIEN,CNAME,PIEN) ;should no longer be used as of patch SD*5.3*433
+1 ;CLIEN - clinic ien
+2 ;CNAME - clinic name returned if patient is enrolled in clien clinic
+3 ;PIEN - patien ien
+4 ;
+5 NEW EN,NODE
+6 SET CNAME=""
+7 IF $DATA(^DPT(PIEN,"DE","B",CLIEN))
Begin DoDot:1
+8 ;enrolled at one time, check if discharged
+9 SET EN=$ORDER(^DPT(PIEN,"DE","B",CLIEN,""))
+10 SET NODE=$GET(^DPT(PIEN,"DE",EN,0))
+11 if NODE=""
QUIT
+12 ;clinic name
IF $PIECE(NODE,"^",3)=""
SET CNAME=$PIECE($GET(^SC(CLIEN,0)),"^")
+13 ;clinic name
IF $PIECE(NODE,"^",3)'=""
IF $PIECE(NODE,"^",3)>DT
SET CNAME=$PIECE($GET(^SC(CLIEN,0)),"^")
End DoDot:1
+14 QUIT
+15 ;
FORMAT(CNAME,PINF,PC,TIEN,TNAME,PRAC,PNAME,POSN,TPI,PRCP) ; format data for display
+1 ;CNAME - clinic name
+2 ;PINF - patient/clinic data
+3 ;PC - primary care 1/0
+4 ;TIEN - team file ien (#404.51)
+5 ;TNAME - team name
+6 ;PRAC - practitioner ien (#200)
+7 ;PNAME - practitioner name
+8 ;POSN - position name
+9 ;TPI - team position ien (#404.57)
+10 ;PRCP - preceptor name
+11 ;
+12 NEW IIEN,INAME,ERR
+13 SET ERR=$$SETUP^SCRPPAT3(.IIEN,.INAME,TIEN,TNAME,PRAC,PNAME,POSN,TPI,PRCP)
+14 IF ERR
QUIT
+15 ;
+16 ;sort division,team,practitioner
IF SORT=1
DO STOR(IIEN,TIEN,PRAC,PINF,PNAME,TNAME,TPI)
+17 ;sort division,practitioner,team
IF SORT=2
DO STOR(IIEN,PRAC,TIEN,PINF,PNAME,TNAME,TPI)
+18 IF SORT=3
DO STOR(1,PRAC,1,PINF,PNAME,"T3",TPI)
+19 QUIT
+20 ;
FORMATAC(CNAME,PINF,PC,TIEN,TNAME,PRAC,PNAME,POSN,TPI,PRCP) ; format data for display
+1 ;CNAME - clinic name
+2 ;PINF - patient/clinic data
+3 ;PC - primary care 1/0
+4 ;TIEN - team file ien (#404.51)
+5 ;TNAME - team name
+6 ;PRAC - practitioner ien (#200)
+7 ;PNAME - practitioner name
+8 ;POSN - position name
+9 ;TPI - team position ien (#404.57)
+10 ;PRCP - preceptor name
+11 ;
+12 NEW IIEN,INAME,ERR
+13 SET ERR=$$SETUP^SCRPPAT3(.IIEN,.INAME,TIEN,TNAME,PRAC,PNAME,POSN,TPI,PRCP)
+14 IF ERR
QUIT
+15 ;
+16 ;sort division,team,practitioner
IF SORT=1
DO STORA(IIEN,TIEN,PRAC,PINF,PNAME,TNAME,TPI,SCCNT)
+17 ;sort division,practitioner,team
IF SORT=2
DO STORA(IIEN,PRAC,TIEN,PINF,PNAME,TNAME,TPI,SCCNT)
+18 IF SORT=3
DO STORA(1,PRAC,1,PINF,PNAME,"T3",TPI,SCCNT)
+19 QUIT
+20 ;
STOR(IIEN,SEC,TRD,PINF,PNAME,TNAME,TPI,SCCNT) ;
+1 ;IIEN - ien institution
+2 ;SEC - second sort subscript, IEN team or IEN practitioner
+3 ;TRD - third sort subscript, IEN team or IEN practitioner
+4 ;PINF - patient/clinic info
+5 ;PNAME - practitioner name
+6 ;TNAME - team name
+7 ;TPI - team position ien
+8 ;
+9 NEW PIEN,PTNAME,PID
+10 ;patient ien
SET PIEN=+$PIECE(PINF,"^")
+11 ;patient name
SET PTNAME=$EXTRACT($PIECE(PINF,"^",2),1,10)
+12 if $DATA(@STORE@("PT",IIEN,SEC,TRD,TPI,PTNAME,PIEN))
QUIT
+13 SET @STORE@("PT",IIEN,SEC,TRD,TPI,PTNAME,PIEN)=""
+14 IF 'SUMM
IF '$DATA(@STORE@("PTOT",IIEN,SEC,TRD,PIEN))
Begin DoDot:1
+15 ;count each unique patient for any given practitioner for grand total
+16 SET @STORE@("PTOT",IIEN,SEC,TRD,PIEN)=""
+17 ;patient count by practitioner
SET @STORE@("TOTAL",IIEN,PRAC,0)=$GET(@STORE@("TOTAL",IIEN,PRAC,0))+1
End DoDot:1
+18 ;
+19 ;patient count by practitioner and team
SET @STORE@("TOTAL",IIEN,PRAC,$SELECT(SORT=3:1,1:TIEN),TPI)=$GET(@STORE@("TOTAL",IIEN,PRAC,$SELECT(SORT=3:1,1:TIEN),TPI))+1
+20 if SUMM
QUIT
+21 ;
+22 SET @STORE@(IIEN,SEC,TRD,TPI,PIEN)=PTNAME
+23 SET PID=$PIECE(PINF,"^",3)
SET PID=$TRANSLATE(PID,"-","")
+24 ;ssn
SET $EXTRACT(@STORE@(IIEN,SEC,TRD,TPI,PIEN),13)=PID
+25 ;means test status
SET $EXTRACT(@STORE@(IIEN,SEC,TRD,TPI,PIEN),25)=$PIECE(PINF,"^",4)
+26 ;eligibility
SET $EXTRACT(@STORE@(IIEN,SEC,TRD,TPI,PIEN),31)=$PIECE(PINF,"^",5)
+27 ;Removed by patch 174
+28 ;S $E(@STORE@(IIEN,SEC,TRD,TPI,PIEN),40)=$P(PINF,"^",6) ;patient status
+29 ;last appt
SET $EXTRACT(@STORE@(IIEN,SEC,TRD,TPI,PIEN),42)=$PIECE(PINF,"^",8)
+30 ;nxt appt
SET $EXTRACT(@STORE@(IIEN,SEC,TRD,TPI,PIEN),54)=$PIECE(PINF,"^",9)
+31 ;clinic
SET $EXTRACT(@STORE@(IIEN,SEC,TRD,TPI,PIEN),66)=$EXTRACT(CNAME,1,15)
+32 QUIT
STORA(IIEN,SEC,TRD,PINF,PNAME,TNAME,TPI,SCCNT) ;
+1 IF '$DATA(@STORE@(IIEN,SEC,TRD,TPI,PIEN,SCCNT))
Begin DoDot:1
+2 ;last appt
SET $EXTRACT(@STORE@(IIEN,SEC,TRD,TPI,PIEN,SCCNT),42)=$PIECE(PINF,"^",8)
+3 ;nxt appt
SET $EXTRACT(@STORE@(IIEN,SEC,TRD,TPI,PIEN,SCCNT),54)=$PIECE(PINF,"^",9)
+4 ;clinic
SET $EXTRACT(@STORE@(IIEN,SEC,TRD,TPI,PIEN,SCCNT),66)=$EXTRACT(CNAME,1,15)
+5 QUIT
End DoDot:1
+6 QUIT
