SCMCCV2 ;ALB/JLU;PC Attending conversion;6/4/1999
;;5.3;Scheduling;**195**;AUG 13, 1993
;
STRTQJOB ;this is the start of the queue job to convert PC Attending
;Assignments.
;The following variables are defined when the job starts
;SCMCTM(X) the array of team IENs as subscripts
;SCMCPOS(X) the array of positions as subscripts
;SCMCFIX is set to either F for fix of C for Check
;SCMCTYPE is set to A for ALL, T for team or P for position
;
N STOP,ZSTOP,SCMCCNT
S SCMCCNT="0^0^0" ;total count^fixed count^err count
S (STOP,ZSTOP)=0
D INIT^SCMCCV1
D BLDLIST
D:$D(^TMP("SCMC",$J)) PROCLIST
D MAIL ;WATCH FOR ZSTOP
K ^TMP("SCMC",$J),^XTMP("SCMCATTCONV")
Q
;
;
BLDLIST ;gathers all the PC Attending Assignments within PCMM database.
;this will be placed in the following global for processing
;^TMP("SCMC",$J,TM IEN,POS IEN,POS ASGN IEN 404.43)=DFN^ASGNDT
;
N DFN,ASGNDT,TMPOS,POSASGN,TMASGN,TMASGNZ,TM
K ^TMP("SCMC",$J)
;
F DFN=0:0 S DFN=$O(^SCPT(404.43,"APCPOS",DFN)) Q:DFN="" F ASGNDT=0:0 S ASGNDT=$O(^SCPT(404.43,"APCPOS",DFN,2,ASGNDT)) Q:ASGNDT="" DO
.F TMPOS=0:0 S TMPOS=$O(^SCPT(404.43,"APCPOS",DFN,2,ASGNDT,TMPOS)) Q:TMPOS="" F POSASGN=0:0 S POSASGN=$O(^SCPT(404.43,"APCPOS",DFN,2,ASGNDT,TMPOS,POSASGN)) Q:POSASGN="" DO
..S TMASGN=+$G(^SCPT(404.43,POSASGN,0))
..I 'TMASGN Q
..I +$P(^SCPT(404.43,POSASGN,0),U,4),$P(^(0),U,4)<DT Q ;has a discharge date in the past.
..S TMASGNZ=$G(^SCPT(404.42,TMASGN,0))
..I 'TMASGNZ Q
..S TM=$P(TMASGNZ,U,3)
..I 'TM Q
..S ^TMP("SCMC",$J,TM,TMPOS,POSASGN)=DFN_"^"_ASGNDT
..Q
.Q
Q
;
;
PROCLIST ;works through the list built by the builder via the SCMCTYPE
;checks are done to ensure the convert can happen then it is converted.
;
;TMP GLOBAL ^TMP("SCMC",$J,TEAM IEN, POS IEN, POS ASSIGNMENT IEN)="DFN^
;ASSIGNMENT DATE FM FORMAT"
;
N TM,POS,POSASGNZ,POSASGN
;
F TM=0:0 S TM=$O(^TMP("SCMC",$J,TM)) Q:+TM<1!(ZSTOP) F POS=0:0 S POS=$O(^TMP("SCMC",$J,TM,POS)) Q:POS=""!(ZSTOP) F POSASGN=0:0 S POSASGN=$O(^TMP("SCMC",$J,TM,POS,POSASGN)) Q:POSASGN="" DO Q:(ZSTOP)
.N PAT,TMPZ,SSN,ASGNDTI,ASGNDTE,DFN,Y
.S TMPZ=^TMP("SCMC",$J,TM,POS,POSASGN)
.S DFN=$P(TMPZ,U,1)
.S PAT=$P(^DPT($P(TMPZ,U,1),0),U,1)
.S SSN=$P(^(0),U,9) ;naked from line before
.S (ASGNDTI,Y)=$P(TMPZ,U,2)
.D DD^%DT
.S ASGNDTE=Y
.I SCMCTYPE="A" D CONVERT
.I SCMCTYPE="T",$D(SCMCTM(TM)) D CONVERT
.I SCMCTYPE="P",$D(SCMCPOS(POS)) D CONVERT
.I '($P(SCMCCNT,U,1)#50) S ZSTOP=$S($$S^%ZTLOAD:1,1:0)
.Q
Q
;
;
BPERCNT ;bumps the error counter
S $P(SCMCCNT,U,3)=$P(SCMCCNT,U,3)+1
Q
;
BPTOTCNT ;bumps the total counter
S $P(SCMCCNT,U,1)=$P(SCMCCNT,U,1)+1
Q
;
BPFXCNT ;bumps the fixed counter
S $P(SCMCCNT,U,2)=$P(SCMCCNT,U,2)+1
Q
;
;
SETERR(ERR) ;set the error into the error global array.
;accepts ERR as the error message
;
N EXTTM,EXTPOS,LAST
S EXTPOS=$P(^SCTM(404.57,POS,0),U,1)
S EXTTM=$P(^SCTM(404.51,TM,0),U,1)
;
;sets up the name of the provider for this position
I '$D(^TMP("SCMC",$J,"ERR",EXTTM,EXTPOS)) DO
.N VAR,SCDATES,SCMCPROV,SCMCERR
.S SCDATES("INCL")=1
.S VAR=$$PRTP^SCAPMC8(POS,"SCDATES","SCMCPROV","SCMCERR")
.I 'VAR Q
.;there should be only one provider for this day
.S ^TMP("SCMC",$J,"ERR",EXTTM,EXTPOS)=$S($D(SCMCPROV(1)):$P(SCMCPROV(1),U,2),1:"No active provider")
.Q
;
;
I '$D(^TMP("SCMC",$J,"ERR",EXTTM,EXTPOS,DFN)) S ^TMP("SCMC",$J,"ERR",EXTTM,EXTPOS,DFN,1)=PAT_"^"_SSN_"^"_ASGNDTE
;
S LAST=$O(^TMP("SCMC",$J,"ERR",EXTTM,EXTPOS,DFN,9999999),-1)
S ^TMP("SCMC",$J,"ERR",EXTTM,EXTPOS,DFN,LAST+1)=ERR
Q
;
;
CONVERT ;performs two checks then calls the tag to conver data.
;
N ERR,VARONE,REASSIGN
D BPTOTCNT
;
S VARONE=$$YSPTTPPC^SCMCTPU2(DFN,ASGNDTI,1)
I 'VARONE DO
.IF $P(VARONE,U,2)["future" D FUTURE^SCMCCV1 I 1
.E S ERR="-"_$P(VARONE,U,2) D SETERR(ERR)
.Q
;
S VARONE='$$CHKTM(POSASGN,.ERR)
;
I $D(ERR) D BPERCNT
I '$D(ERR) DO
.I SCMCFIX="F" D @$S($D(REASSIGN):"REASGN",1:"CHANGE^SCMCCV1("_POSASGN_")")
.D BPFXCNT ;also counts a fix if in check mode.
.Q
;
CONQ Q
;
;
REASGN ;discharge old PC Attending and makes new PC Practitioner for today.
;
N VARTHREE,RETURN,FIELDS,SCCONER
S SCCONER="^TMP(""SCMC"",$J,""JUNK"")"
S VARTHREE=$$INPTTP^SCAPMC(DFN,POSASGN,DT-1,SCCONER)
I 'VARTHREE S ERR="-Could not discharge old PC Attending Assignment "_POSASGN D SETERR(ERR) Q
S FIELDS(.05)=1,FIELDS(.06)=$G(DUZ,.5),FIELDS(.07)=DT
S RETURN=$$ACPTTP^SCAPMC21(DFN,POS,"FIELDS",DT,SCCONER)
K @SCCONER
I $P(RETURN,U,2)=1 Q
D REOPEN^SCMCCV1
S ERR="-Could not create a new position assignment. PC Attending reactivated." D SETERR(ERR)
Q
;
;
CHKTM(ASGIEN,ERR) ;Performs checks on the team assignments
;
N TMASGN,RES,POSASGNZ
S RES=1
;
S POSASGNZ=$G(^SCPT(404.43,ASGIEN,0))
I POSASGNZ="" S ERR="-Missing Patient Team Position Assignment.",RES=0 D SETERR(ERR)
;
S TMASGN=$P(POSASGNZ,U,1)
I +TMASGN'>0 S ERR="-Bad team assignment pointer.",RES=0 D SETERR(ERR)
;
S TMASGN=$G(^SCPT(404.42,TMASGN,0))
I TMASGN="" S ERR="-Missing Team Assignment.",RES=0 D SETERR(ERR)
;
I $P(TMASGN,U,9)>0 S ERR="-Patient Team Assignment status is discharged.",RES=0 D SETERR(ERR)
;
I $P(TMASGN,U,8)'=1 S ERR="-PC Role only allowed if Patient Team Assignment is for Primary Care",RES=0 D SETERR(ERR)
;
CHKQ Q RES
;
;
MAIL ;sets up message for conversion and delivers.
;
N XMY,XMTEST,XMSUB,XMDUZ,CNTR
;
D INIT^SCMCCV1
I '$D(^TMP("SCMC",$J)) D
. D SET("")
. D SET("No PC Attending Assignments to evaluate!")
. Q
E D
. D TEXT
. D TOTALS
. D ERRORS
. Q
D ^XMD
Q
;
;
TEXT ;fills in the text of the message
;
D HDR
I SCMCTYPE="A" D LISTA
I SCMCTYPE="T" D LISTT
I SCMCTYPE="P" D LISTP
I ZSTOP D STOPPED
Q
;
;
HDR ;header for check mode.
;
D SET("The conversion software was run in a "_$S(SCMCFIX="C":"'CHECK'",1:"'FIX'")_" mode.")
;
I SCMCFIX="C" D SET("No actual conversion took place.")
E DO
.D SET("When possible the PC Attending assignment was changed to PC Practitioner.")
.D SET("If it could not be converted an error message is listed and the assignment was left in its original state.")
.Q
;
D SET("")
Q
;
;
LISTA ;
D SET("All PCMM Teams and Positions were reviewed.")
Q
;
;
LISTT ;
N VAR
D SET("Team(s):")
S VAR=0
F S VAR=$O(SCMCTM(VAR)) Q:VAR="" D SET($P(^SCTM(404.51,VAR,0),U,1))
D SET(" ")
D SET("All positions for each team are included.")
Q
;
;
LISTP ;
N VAR
D SET("Team:")
S VAR=$O(SCMCTM(0))
D SET($P(^SCTM(404.51,VAR,0),U,1))
D SET(" ")
D SET("Position(s):")
S VAR=0
F S VAR=$O(SCMCPOS(VAR)) Q:VAR="" D SET($P(^SCTM(404.57,VAR,0),U,1))
Q
;
;
TOTALS ;fills the totals into the message.
;
D SET(" ")
D SET(" ")
D SET("Assignments reviewed: "_$P(SCMCCNT,U,1))
D SET("Assignments "_$S(SCMCFIX="C":"that would have been ",1:"")_"converted: "_$P(SCMCCNT,U,2))
D SET("Assignments that could not be converted: "_$P(SCMCCNT,U,3))
D SET(" ")
Q
;
;
ERRORS ;load in the error messages into the report.
;
;^TMP("SCMC",$J,"ERR",TEAM,POSITION,DFN,1) = PATIENT^SSN^ASSIGNMENT DATE
;
N VAR
D SET(" ")
D SET(" ")
D SET("The following assignments could not be converted and why:")
D SET(" ")
D SET("Patient Name SSN Team Position Assignment Date")
D SET("------------------------------------------------------------------------------")
;
N TM,POS,ASGNDT,DFN
S TM=""
F S TM=$O(^TMP("SCMC",$J,"ERR",TM)) Q:TM="" DO
.D SET(" ")
.D SET(" ")
.D SET("Team==> "_TM)
.S POS="" F S POS=$O(^TMP("SCMC",$J,"ERR",TM,POS)) Q:POS="" DO
..D SET("Position==> "_POS_" ("_^TMP("SCMC",$J,"ERR",TM,POS)_")")
..F DFN=0:0 S DFN=$O(^TMP("SCMC",$J,"ERR",TM,POS,DFN)) Q:DFN="" DO
...N PAT,VAR1,LP,ERR,TITLE
...S VAR1=^TMP("SCMC",$J,"ERR",TM,POS,DFN,1)
...S TITLE=$P(VAR1,U,1)
...D PADTO(25,.TITLE)
...S TITLE=TITLE_$E($P(VAR1,U,2),6,9)
...D PADTO(31,.TITLE)
...S TITLE=TITLE_$E(TM,1,15)
...D PADTO(48,.TITLE)
...S TITLE=TITLE_$E(POS,1,15)
...D PADTO(65,.TITLE)
...S TITLE=TITLE_$P(VAR1,U,3)
...D SET(TITLE)
...F LP=2:1 S ERR=$G(^TMP("SCMC",$J,"ERR",TM,POS,DFN,LP)) Q:ERR="" D SET(" "_ERR)
...Q
..Q
.Q
Q
;
;
PADTO(TOT,VAR) ;
S VAR=$$LJ^XLFSTR(VAR,TOT)
Q
;
;
SET(X) ;sets data into the correct mail storage global
;
S CNTR=CNTR+1
S ^TMP("SCMC",$J,"MSG",CNTR,0)=X
Q
;
;
STOPPED ;
D SET(" ")
D SET("*** The conversion job was stopped by request.")
D SET("*** Some data was still processed.")
D SET("*** Contact your IRM for more information. ***")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCMCCV2 8717 printed Apr 09, 2024@21:48:31 Page 2
SCMCCV2 ;ALB/JLU;PC Attending conversion;6/4/1999
+1 ;;5.3;Scheduling;**195**;AUG 13, 1993
+2 ;
STRTQJOB ;this is the start of the queue job to convert PC Attending
+1 ;Assignments.
+2 ;The following variables are defined when the job starts
+3 ;SCMCTM(X) the array of team IENs as subscripts
+4 ;SCMCPOS(X) the array of positions as subscripts
+5 ;SCMCFIX is set to either F for fix of C for Check
+6 ;SCMCTYPE is set to A for ALL, T for team or P for position
+7 ;
+8 NEW STOP,ZSTOP,SCMCCNT
+9 ;total count^fixed count^err count
SET SCMCCNT="0^0^0"
+10 SET (STOP,ZSTOP)=0
+11 DO INIT^SCMCCV1
+12 DO BLDLIST
+13 if $DATA(^TMP("SCMC",$JOB))
DO PROCLIST
+14 ;WATCH FOR ZSTOP
DO MAIL
+15 KILL ^TMP("SCMC",$JOB),^XTMP("SCMCATTCONV")
+16 QUIT
+17 ;
+18 ;
BLDLIST ;gathers all the PC Attending Assignments within PCMM database.
+1 ;this will be placed in the following global for processing
+2 ;^TMP("SCMC",$J,TM IEN,POS IEN,POS ASGN IEN 404.43)=DFN^ASGNDT
+3 ;
+4 NEW DFN,ASGNDT,TMPOS,POSASGN,TMASGN,TMASGNZ,TM
+5 KILL ^TMP("SCMC",$JOB)
+6 ;
+7 FOR DFN=0:0
SET DFN=$ORDER(^SCPT(404.43,"APCPOS",DFN))
if DFN=""
QUIT
FOR ASGNDT=0:0
SET ASGNDT=$ORDER(^SCPT(404.43,"APCPOS",DFN,2,ASGNDT))
if ASGNDT=""
QUIT
Begin DoDot:1
+8 FOR TMPOS=0:0
SET TMPOS=$ORDER(^SCPT(404.43,"APCPOS",DFN,2,ASGNDT,TMPOS))
if TMPOS=""
QUIT
FOR POSASGN=0:0
SET POSASGN=$ORDER(^SCPT(404.43,"APCPOS",DFN,2,ASGNDT,TMPOS,POSASGN))
if POSASGN=""
QUIT
Begin DoDot:2
+9 SET TMASGN=+$GET(^SCPT(404.43,POSASGN,0))
+10 IF 'TMASGN
QUIT
+11 ;has a discharge date in the past.
IF +$PIECE(^SCPT(404.43,POSASGN,0),U,4)
IF $PIECE(^(0),U,4)<DT
QUIT
+12 SET TMASGNZ=$GET(^SCPT(404.42,TMASGN,0))
+13 IF 'TMASGNZ
QUIT
+14 SET TM=$PIECE(TMASGNZ,U,3)
+15 IF 'TM
QUIT
+16 SET ^TMP("SCMC",$JOB,TM,TMPOS,POSASGN)=DFN_"^"_ASGNDT
+17 QUIT
End DoDot:2
+18 QUIT
End DoDot:1
+19 QUIT
+20 ;
+21 ;
PROCLIST ;works through the list built by the builder via the SCMCTYPE
+1 ;checks are done to ensure the convert can happen then it is converted.
+2 ;
+3 ;TMP GLOBAL ^TMP("SCMC",$J,TEAM IEN, POS IEN, POS ASSIGNMENT IEN)="DFN^
+4 ;ASSIGNMENT DATE FM FORMAT"
+5 ;
+6 NEW TM,POS,POSASGNZ,POSASGN
+7 ;
+8 FOR TM=0:0
SET TM=$ORDER(^TMP("SCMC",$JOB,TM))
if +TM<1!(ZSTOP)
QUIT
FOR POS=0:0
SET POS=$ORDER(^TMP("SCMC",$JOB,TM,POS))
if POS=""!(ZSTOP)
QUIT
FOR POSASGN=0:0
SET POSASGN=$ORDER(^TMP("SCMC",$JOB,TM,POS,POSASGN))
if POSASGN=""
QUIT
Begin DoDot:1
+9 NEW PAT,TMPZ,SSN,ASGNDTI,ASGNDTE,DFN,Y
+10 SET TMPZ=^TMP("SCMC",$JOB,TM,POS,POSASGN)
+11 SET DFN=$PIECE(TMPZ,U,1)
+12 SET PAT=$PIECE(^DPT($PIECE(TMPZ,U,1),0),U,1)
+13 ;naked from line before
SET SSN=$PIECE(^(0),U,9)
+14 SET (ASGNDTI,Y)=$PIECE(TMPZ,U,2)
+15 DO DD^%DT
+16 SET ASGNDTE=Y
+17 IF SCMCTYPE="A"
DO CONVERT
+18 IF SCMCTYPE="T"
IF $DATA(SCMCTM(TM))
DO CONVERT
+19 IF SCMCTYPE="P"
IF $DATA(SCMCPOS(POS))
DO CONVERT
+20 IF '($PIECE(SCMCCNT,U,1)#50)
SET ZSTOP=$SELECT($$S^%ZTLOAD:1,1:0)
+21 QUIT
End DoDot:1
if (ZSTOP)
QUIT
+22 QUIT
+23 ;
+24 ;
BPERCNT ;bumps the error counter
+1 SET $PIECE(SCMCCNT,U,3)=$PIECE(SCMCCNT,U,3)+1
+2 QUIT
+3 ;
BPTOTCNT ;bumps the total counter
+1 SET $PIECE(SCMCCNT,U,1)=$PIECE(SCMCCNT,U,1)+1
+2 QUIT
+3 ;
BPFXCNT ;bumps the fixed counter
+1 SET $PIECE(SCMCCNT,U,2)=$PIECE(SCMCCNT,U,2)+1
+2 QUIT
+3 ;
+4 ;
SETERR(ERR) ;set the error into the error global array.
+1 ;accepts ERR as the error message
+2 ;
+3 NEW EXTTM,EXTPOS,LAST
+4 SET EXTPOS=$PIECE(^SCTM(404.57,POS,0),U,1)
+5 SET EXTTM=$PIECE(^SCTM(404.51,TM,0),U,1)
+6 ;
+7 ;sets up the name of the provider for this position
+8 IF '$DATA(^TMP("SCMC",$JOB,"ERR",EXTTM,EXTPOS))
Begin DoDot:1
+9 NEW VAR,SCDATES,SCMCPROV,SCMCERR
+10 SET SCDATES("INCL")=1
+11 SET VAR=$$PRTP^SCAPMC8(POS,"SCDATES","SCMCPROV","SCMCERR")
+12 IF 'VAR
QUIT
+13 ;there should be only one provider for this day
+14 SET ^TMP("SCMC",$JOB,"ERR",EXTTM,EXTPOS)=$SELECT($DATA(SCMCPROV(1)):$PIECE(SCMCPROV(1),U,2),1:"No active provider")
+15 QUIT
End DoDot:1
+16 ;
+17 ;
+18 IF '$DATA(^TMP("SCMC",$JOB,"ERR",EXTTM,EXTPOS,DFN))
SET ^TMP("SCMC",$JOB,"ERR",EXTTM,EXTPOS,DFN,1)=PAT_"^"_SSN_"^"_ASGNDTE
+19 ;
+20 SET LAST=$ORDER(^TMP("SCMC",$JOB,"ERR",EXTTM,EXTPOS,DFN,9999999),-1)
+21 SET ^TMP("SCMC",$JOB,"ERR",EXTTM,EXTPOS,DFN,LAST+1)=ERR
+22 QUIT
+23 ;
+24 ;
CONVERT ;performs two checks then calls the tag to conver data.
+1 ;
+2 NEW ERR,VARONE,REASSIGN
+3 DO BPTOTCNT
+4 ;
+5 SET VARONE=$$YSPTTPPC^SCMCTPU2(DFN,ASGNDTI,1)
+6 IF 'VARONE
Begin DoDot:1
+7 IF $PIECE(VARONE,U,2)["future"
DO FUTURE^SCMCCV1
IF 1
+8 IF '$TEST
SET ERR="-"_$PIECE(VARONE,U,2)
DO SETERR(ERR)
+9 QUIT
End DoDot:1
+10 ;
+11 SET VARONE='$$CHKTM(POSASGN,.ERR)
+12 ;
+13 IF $DATA(ERR)
DO BPERCNT
+14 IF '$DATA(ERR)
Begin DoDot:1
+15 IF SCMCFIX="F"
DO @$SELECT($DATA(REASSIGN):"REASGN",1:"CHANGE^SCMCCV1("_POSASGN_")")
+16 ;also counts a fix if in check mode.
DO BPFXCNT
+17 QUIT
End DoDot:1
+18 ;
CONQ QUIT
+1 ;
+2 ;
REASGN ;discharge old PC Attending and makes new PC Practitioner for today.
+1 ;
+2 NEW VARTHREE,RETURN,FIELDS,SCCONER
+3 SET SCCONER="^TMP(""SCMC"",$J,""JUNK"")"
+4 SET VARTHREE=$$INPTTP^SCAPMC(DFN,POSASGN,DT-1,SCCONER)
+5 IF 'VARTHREE
SET ERR="-Could not discharge old PC Attending Assignment "_POSASGN
DO SETERR(ERR)
QUIT
+6 SET FIELDS(.05)=1
SET FIELDS(.06)=$GET(DUZ,.5)
SET FIELDS(.07)=DT
+7 SET RETURN=$$ACPTTP^SCAPMC21(DFN,POS,"FIELDS",DT,SCCONER)
+8 KILL @SCCONER
+9 IF $PIECE(RETURN,U,2)=1
QUIT
+10 DO REOPEN^SCMCCV1
+11 SET ERR="-Could not create a new position assignment. PC Attending reactivated."
DO SETERR(ERR)
+12 QUIT
+13 ;
+14 ;
CHKTM(ASGIEN,ERR) ;Performs checks on the team assignments
+1 ;
+2 NEW TMASGN,RES,POSASGNZ
+3 SET RES=1
+4 ;
+5 SET POSASGNZ=$GET(^SCPT(404.43,ASGIEN,0))
+6 IF POSASGNZ=""
SET ERR="-Missing Patient Team Position Assignment."
SET RES=0
DO SETERR(ERR)
+7 ;
+8 SET TMASGN=$PIECE(POSASGNZ,U,1)
+9 IF +TMASGN'>0
SET ERR="-Bad team assignment pointer."
SET RES=0
DO SETERR(ERR)
+10 ;
+11 SET TMASGN=$GET(^SCPT(404.42,TMASGN,0))
+12 IF TMASGN=""
SET ERR="-Missing Team Assignment."
SET RES=0
DO SETERR(ERR)
+13 ;
+14 IF $PIECE(TMASGN,U,9)>0
SET ERR="-Patient Team Assignment status is discharged."
SET RES=0
DO SETERR(ERR)
+15 ;
+16 IF $PIECE(TMASGN,U,8)'=1
SET ERR="-PC Role only allowed if Patient Team Assignment is for Primary Care"
SET RES=0
DO SETERR(ERR)
+17 ;
CHKQ QUIT RES
+1 ;
+2 ;
MAIL ;sets up message for conversion and delivers.
+1 ;
+2 NEW XMY,XMTEST,XMSUB,XMDUZ,CNTR
+3 ;
+4 DO INIT^SCMCCV1
+5 IF '$DATA(^TMP("SCMC",$JOB))
Begin DoDot:1
+6 DO SET("")
+7 DO SET("No PC Attending Assignments to evaluate!")
+8 QUIT
End DoDot:1
+9 IF '$TEST
Begin DoDot:1
+10 DO TEXT
+11 DO TOTALS
+12 DO ERRORS
+13 QUIT
End DoDot:1
+14 DO ^XMD
+15 QUIT
+16 ;
+17 ;
TEXT ;fills in the text of the message
+1 ;
+2 DO HDR
+3 IF SCMCTYPE="A"
DO LISTA
+4 IF SCMCTYPE="T"
DO LISTT
+5 IF SCMCTYPE="P"
DO LISTP
+6 IF ZSTOP
DO STOPPED
+7 QUIT
+8 ;
+9 ;
HDR ;header for check mode.
+1 ;
+2 DO SET("The conversion software was run in a "_$SELECT(SCMCFIX="C":"'CHECK'",1:"'FIX'")_" mode.")
+3 ;
+4 IF SCMCFIX="C"
DO SET("No actual conversion took place.")
+5 IF '$TEST
Begin DoDot:1
+6 DO SET("When possible the PC Attending assignment was changed to PC Practitioner.")
+7 DO SET("If it could not be converted an error message is listed and the assignment was left in its original state.")
+8 QUIT
End DoDot:1
+9 ;
+10 DO SET("")
+11 QUIT
+12 ;
+13 ;
LISTA ;
+1 DO SET("All PCMM Teams and Positions were reviewed.")
+2 QUIT
+3 ;
+4 ;
LISTT ;
+1 NEW VAR
+2 DO SET("Team(s):")
+3 SET VAR=0
+4 FOR
SET VAR=$ORDER(SCMCTM(VAR))
if VAR=""
QUIT
DO SET($PIECE(^SCTM(404.51,VAR,0),U,1))
+5 DO SET(" ")
+6 DO SET("All positions for each team are included.")
+7 QUIT
+8 ;
+9 ;
LISTP ;
+1 NEW VAR
+2 DO SET("Team:")
+3 SET VAR=$ORDER(SCMCTM(0))
+4 DO SET($PIECE(^SCTM(404.51,VAR,0),U,1))
+5 DO SET(" ")
+6 DO SET("Position(s):")
+7 SET VAR=0
+8 FOR
SET VAR=$ORDER(SCMCPOS(VAR))
if VAR=""
QUIT
DO SET($PIECE(^SCTM(404.57,VAR,0),U,1))
+9 QUIT
+10 ;
+11 ;
TOTALS ;fills the totals into the message.
+1 ;
+2 DO SET(" ")
+3 DO SET(" ")
+4 DO SET("Assignments reviewed: "_$PIECE(SCMCCNT,U,1))
+5 DO SET("Assignments "_$SELECT(SCMCFIX="C":"that would have been ",1:"")_"converted: "_$PIECE(SCMCCNT,U,2))
+6 DO SET("Assignments that could not be converted: "_$PIECE(SCMCCNT,U,3))
+7 DO SET(" ")
+8 QUIT
+9 ;
+10 ;
ERRORS ;load in the error messages into the report.
+1 ;
+2 ;^TMP("SCMC",$J,"ERR",TEAM,POSITION,DFN,1) = PATIENT^SSN^ASSIGNMENT DATE
+3 ;
+4 NEW VAR
+5 DO SET(" ")
+6 DO SET(" ")
+7 DO SET("The following assignments could not be converted and why:")
+8 DO SET(" ")
+9 DO SET("Patient Name SSN Team Position Assignment Date")
+10 DO SET("------------------------------------------------------------------------------")
+11 ;
+12 NEW TM,POS,ASGNDT,DFN
+13 SET TM=""
+14 FOR
SET TM=$ORDER(^TMP("SCMC",$JOB,"ERR",TM))
if TM=""
QUIT
Begin DoDot:1
+15 DO SET(" ")
+16 DO SET(" ")
+17 DO SET("Team==> "_TM)
+18 SET POS=""
FOR
SET POS=$ORDER(^TMP("SCMC",$JOB,"ERR",TM,POS))
if POS=""
QUIT
Begin DoDot:2
+19 DO SET("Position==> "_POS_" ("_^TMP("SCMC",$JOB,"ERR",TM,POS)_")")
+20 FOR DFN=0:0
SET DFN=$ORDER(^TMP("SCMC",$JOB,"ERR",TM,POS,DFN))
if DFN=""
QUIT
Begin DoDot:3
+21 NEW PAT,VAR1,LP,ERR,TITLE
+22 SET VAR1=^TMP("SCMC",$JOB,"ERR",TM,POS,DFN,1)
+23 SET TITLE=$PIECE(VAR1,U,1)
+24 DO PADTO(25,.TITLE)
+25 SET TITLE=TITLE_$EXTRACT($PIECE(VAR1,U,2),6,9)
+26 DO PADTO(31,.TITLE)
+27 SET TITLE=TITLE_$EXTRACT(TM,1,15)
+28 DO PADTO(48,.TITLE)
+29 SET TITLE=TITLE_$EXTRACT(POS,1,15)
+30 DO PADTO(65,.TITLE)
+31 SET TITLE=TITLE_$PIECE(VAR1,U,3)
+32 DO SET(TITLE)
+33 FOR LP=2:1
SET ERR=$GET(^TMP("SCMC",$JOB,"ERR",TM,POS,DFN,LP))
if ERR=""
QUIT
DO SET(" "_ERR)
+34 QUIT
End DoDot:3
+35 QUIT
End DoDot:2
+36 QUIT
End DoDot:1
+37 QUIT
+38 ;
+39 ;
PADTO(TOT,VAR) ;
+1 SET VAR=$$LJ^XLFSTR(VAR,TOT)
+2 QUIT
+3 ;
+4 ;
SET(X) ;sets data into the correct mail storage global
+1 ;
+2 SET CNTR=CNTR+1
+3 SET ^TMP("SCMC",$JOB,"MSG",CNTR,0)=X
+4 QUIT
+5 ;
+6 ;
STOPPED ;
+1 DO SET(" ")
+2 DO SET("*** The conversion job was stopped by request.")
+3 DO SET("*** Some data was still processed.")
+4 DO SET("*** Contact your IRM for more information. ***")
+5 QUIT
