- 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 Feb 19, 2025@00:06:27 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