SD53P504 ;BP/DMR - Check PCMM OIF/OEF entries. 6/23/2009 ; 9/22/09 11:14am
;;5.3;PIMS;**1016**;JUN 30, 2012;Build 20
PRE ;
N ZZ
S ZZ=$$GET1^DIQ(404.91,1_",",803,"I") I ZZ'="" D
.IF ZZ=1 S $P(^SD(404.91,1,"PCMM"),"^",3)=0
I $$INIT()=0 D ;run config checks for OIF OEF
. D BMES^XPDUTL("The OIF OEF team is not set up correctly.")
. D MES^XPDUTL("Installation aborted.")
. S XPDABORT=1
Q
POST ;
D CLEAN(1)
Q
INIT() ;
;inputs none
;outputs 0=fail
; 1=success
S (DFN,IEN,JJ,TEAM,TIEN,TPOS,TPOSC,TPIEN,TPUR,PUR,ROLE,COUNT,PC,STAT)="" S HOLD=0
K ^TMP("SCMMT"),^TMP("SCMMR")
N SCTFG ;success/fail team config
N SCRFG ;success/fail role config
S SCTFG=$$TEAM()
S SCRFG=$$ROLE()
D EXIT
Q $S(SCTFG=0:0,SCRFG=0:0,1:1)
TEAM() ;
;if only one active team w/oif oef purp and pc=no count=9
S TEAM="" S COUNT=8 F S TEAM=$O(^SCTM(404.51,"B",TEAM)) Q:TEAM="" D
.S TIEN="" F S TIEN=$O(^SCTM(404.51,"B",TEAM,TIEN)) Q:TIEN="" D
..D HISTM Q:STAT'=1
..S TPUR="" S TPUR=$$GET1^DIQ(404.51,TIEN_",",.03,"E")
..IF TPUR["OIF"!(TPUR["OEF") D
...S COUNT=COUNT+1
...S PC="" S PC=$$GET1^DIQ(404.51,TIEN_",",.05)
...IF PC="YES" S COUNT=COUNT+1
...S ^TMP("SCMMT",$J,COUNT)="TEAM: "_TEAM
...S COUNT=COUNT+1 S ^TMP("SCMMT",$J,COUNT)="PRIMARY CARE TEAM: "_PC
...S COUNT=COUNT+1 S ^TMP("SCMMT",$J,COUNT)=""
...Q
IF COUNT>11 D MESS1 Q 0 ;oif oef team set to pc
IF COUNT=8 D MESS1 Q 0 ;no active oif oef team
Q 1
ROLE() ;
S (TEAM,TPUR,ROIF,TOIF,TPOIF,TPHS,TPHN,STAT,TPH,STAT,RIEN,APC)="",CC=6
S TPOS="" F S TPOS=$O(^SCTM(404.57,"B",TPOS)) Q:TPOS="" D
.S TPIEN="" F S TPIEN=$O(^SCTM(404.57,"B",TPOS,TPIEN)) Q:TPIEN="" D
..D HIST
..Q:STAT=0
..S RIEN="" S RIEN=$$GET1^DIQ(404.57,TPIEN_",",.03,"I")
..S ROLE="" S ROLE=$$GET1^DIQ(404.57,TPIEN_",",.03,"E")
..S ROIF="" IF ROLE["OIF"!(ROLE["OEF") S ROIF="Y"
..S TEAM=$$GET1^DIQ(404.57,TPIEN_",",.02),TIEN=$$GET1^DIQ(404.57,TPIEN_",",.02,"I")
..D HISTM Q:STAT'=1 ;exclude positions on inactive teams
..S (TOIF,TPOIF)="" S TPUR=$$GET1^DIQ(404.51,TIEN_",",.03) IF TPUR["OIF"!(TPUR["OEF") S (TOIF,TPOIF)="Y"
..S PPP=$$GET1^DIQ(404.57,TPIEN_",",.04,"E")
..D SAVE IF SAVE="Y" D
...S CC=CC+1 S ^TMP("SCMMR",$J,CC)=""
...S CC=CC+1 S ^TMP("SCMMR",$J,CC)="TEAM: "_TEAM
...S CC=CC+1 S ^TMP("SCMMR",$J,CC)="TEAM POSITION: "_TPOS
...S CC=CC+1 S ^TMP("SCMMR",$J,CC)="TEAM PURPOSE: "_TPUR
...S CC=CC+1 S ^TMP("SCMMR",$J,CC)="ROLE: "_ROLE
...S CC=CC+1 S ^TMP("SCMMR",$J,CC)="POSSIBLE PRIMARY PRACTITIONER: "_PPP
...Q
IF CC>6 D MESS2 Q 0
Q 1
HIST ;Get TEAM POSITION HISTORY status.
S (STAT,TPH,TPHN)=""
S TPHN="" F S TPHN=$O(^SCTM(404.59,"B",TPIEN,TPHN)) Q:TPHN="" D
.S TPH="" S STAT=$$GET1^DIQ(404.59,TPHN_",",.03,"I")
.S TPHDT=$$GET1^DIQ(404.59,TPHN_",",.02,"I")
.IF TPHDT>DT S STAT='STAT
.Q
Q
HISTM ;Get TEAM HISTORY status
S IEN="" F S IEN=$O(^SCTM(404.58,"B",TIEN,IEN)) Q:IEN="" D
.S STAT=$$GET1^DIQ(404.58,IEN_",",.03,"I")
.S THDT=$$GET1^DIQ(404.58,IEN_",",.02,"I")
.IF THDT>DT S STAT='STAT
Q
SAVE ;
S SAVE=""
Q:ROIF=""&(TOIF=""&(TPOIF=""))
IF ROIF="Y"&(TOIF=""!(TPOIF="")) S SAVE="Y"
IF ROIF=""&(TOIF="Y"!(TPOIF="Y")) S SAVE="Y"
IF TOIF="Y"&(ROIF=""!(TPOIF="")) S SAVE="Y"
IF TOIF=""&(ROIF="Y"!(TPOIF="Y")) S SAVE="Y"
IF TPOIF="Y"&(ROIF=""!(TOIF="")) S SAVE="Y"
IF TPOIF=""&(ROIF="Y"!(TOIF="")) S SAVE="Y"
Q
;
MESS1 ;Create message if more than 1 oif oef team.
S ^TMP("SCMMT",$J,1)="The setup of the OIF OEF team at this site is incorrect."
S ^TMP("SCMMT",$J,2)="The business rules governing PCMM OIF OEF teams state that each"
S ^TMP("SCMMT",$J,3)="site can have only one OIF OEF team. That team cannot provide primary care."
S ^TMP("SCMMT",$J,4)="Please correct errors as soon as possible; you will continue "
S ^TMP("SCMMT",$J,5)="to receive this message until all errors are resolved."
S ^TMP("SCMMT",$J,6)=""
S ^TMP("SCMMT",$J,7)="THE FOLLOWING IS A LIST OF OIF OEF TEAMS AT THIS INSTITUTION:"
S ^TMP("SCMMT",$J,8)=""
N XMSUB,XMY,XMTEST,XMDUZ
S XMSUB="PCMM OIF OEF TEAMS"
S XMY("G.PCMM HL7 MESSAGES")=""
S XMTEXT="^TMP(""SCMMT"",$J,"
D ^XMD
S HOLD="Y"
Q
MESS2 ;Create message for bad entries involving oif oef teams.
S ^TMP("SCMMR",$J,1)="The PCMM TEAM POSITIONS listed below have inconsistencies"
S ^TMP("SCMMR",$J,2)="in the set up of OIF OEF Teams and Positions in the PCMM package."
S ^TMP("SCMMR",$J,3)="Please review the business rules pertaining to the set up of"
S ^TMP("SCMMR",$J,4)="OIF OEF Teams and Positions. The PCMM HL7 Transmission will not"
S ^TMP("SCMMR",$J,5)="transmit until these errors are corrected. If additional assistance"
S ^TMP("SCMMR",$J,6)="is needed please contact the national helpdesk."
N XMSUB,XMY,XMTEST,XMDUZ
S XMSUB="PCMM OIF OEF ERROR MESSAGE"
S XMY("G.PCMM HL7 MESSAGES")=""
S XMTEXT="^TMP(""SCMMR"",$J,"
D ^XMD
S HOLD="Y"
Q
CLEAN(SCOIFG) ;clean up errors in transmission log
;inputs
; 0=bad OIF OEF config
; 1=good OIF OEF config
;
;error profile
; patient=null
; practitioner=null
; status=rj
; ZPC ID exists
;
N SCI,SCJ,SCK,SCA,DFN,SC1
N SC0 ;0 node 404.471
N SC043 ;0 node 404.43
N SCT,SCT1,SCT2 ;counters
N SCTP ;position ien
N SCEPS ;return value
N SCSTAT ;return value
N SCERR ;error text
N SCARRAY ;array of ZPC segments
N SCIENS ;ien 404.47141
;;;
S (SC043,SCK,SCT,SCT1,SCT2)=0
D BMES^XPDUTL("Cleaning PCMM Transmission Log")
F SCI=0:0 S SCI=$O(^SCPT(404.471,"ASTAT","RJ",SCI)) Q:SCI'>0 D
. S SC0=$G(^SCPT(404.471,SCI,0)) ;get 0 node
. I (+$P(SC0,U,2)_U_(+$P(SC0,U,8)))'="0^0" Q ;exclude
. S SCA=0 F SCK=0:0 S SCK=$O(^SCPT(404.471,SCI,"ZPC",SCK)) Q:SCK=""!(+SCA>0) D
.. S SCIENS=SCK_","_SCI,SCA=+($$GET1^DIQ(404.47141,SCIENS,.02))
. Q:SCA=0 ;exclude if no ZPC ID
. S SC043=$G(^SCPT(404.43,SCA,0))
. ;close log entry
. F SCK=0:0 S SCK=$O(^SCPT(404.471,SCI,"ERR",SCK)) Q:SCK'>0 D
.. S SCEPS=$$UPDEPS^SCMCHLA(SCI,SCK,2,.SCERR)
. S SCSTAT=$$UPDSTAT^SCMCHLA(SCI,"RT",.SCERR)
. I SCERR'="" D Q
.. S SCT2=SCT2+1
.. S SCARRAY(SCI)=SCERR
. S SCT1=SCT1+1 W:SCT1\5 "."
. Q:SC043=0 ;stop processing log entries with no 404.43
. S DFN=+$P($G(^SCPT(404.42,+SC043,0)),U)
. S SCTP=+$P(SC043,U,2)
. ;only re-send if good 404.43 record and no OIF OEF errors
. I DFN>0&(SCOIFG) D
.. D ADD^SCMCHLE("NOW",+SCA_";SCPT(404.43,",DFN,SCTP)
.. S SCT=SCT+1
I SCT_U_SCT1'=(0_U_0) D MSG(SCT_U_SCT1_U_SCT2,.SCARRAY)
K ^TMP("SCOIF",$J)
Q
MSG(SC1,SCARRAY) ;
;inputs
N XMY,XMDUZ,XMSUB,XMTEXT
N SCIX,SCI
S XMDUZ="PCMM Module"
S XMY("G.PCMM HL7 MESSAGES")=""
S XMSUB="PCMM Transmission Log Clean Up"
S XMTEXT="^TMP(""SCOIF"",$J,"
K ^TMP("SCOIF",$J)
S ^TMP("SCOIF",$J,1)=""
S ^TMP("SCOIF",$J,2)="Number of transmission log entries that were closed: "_+$P(SC1,U,2)
S ^TMP("SCOIF",$J,3)="Number of OIF OEF patient assignments that will be re-transmitted: "_+$P(SC1,U)
S ^TMP("SCOIF",$J,4)=""
I +$P(SC1,U,3) D
. S ^TMP("SCOIF",$J,5)="The following transmission log entries could not be closed: "
. S ^TMP("SCOIF",$J,6)="IEN"_$J(" ",7)_"Msg ID"_$J(" ",11)_"Error"
. S SCI="" F SCIX=7:1 S SCI=$O(SCARRAY(SCI)) Q:SCI="" D
.. S ^TMP("SCOIF",$J,SCIX)=SCI_$J(" ",10-$L(SCI))_$$GET1^DIQ(404.471,SCI,.01,"E")_$J(" ",7)_SCARRAY(SCI)
..S ^TMP("SCOIF",$J,SCIX+1)=""
D ^XMD
Q
EXIT ;End routine
K DFN,IEN,JJ,TEAM,TIEN,TPOS,TPOSC,TPIEN,TPUR,PUR,ROLE,COUNT
K TEAM,TPUR,TIEN,ROIF,TOIF,TPOIF,TPHS,TPHN,STAT,RIEN,APC
K CC,PC,PPP,SAVE,THDT,TPH,TPHDT,XMTEXT,HOLD,IENS
K ^TMP("SCMMT",$J),^TMP("SCMMR",$J)
Q
SD53P504 ;BP/DMR - Check PCMM OIF/OEF entries. 6/23/2009 ; 9/22/09 11:14am
+1 ;;5.3;PIMS;**1016**;JUN 30, 2012;Build 20
PRE ;
+1 NEW ZZ
+2 SET ZZ=$$GET1^DIQ(404.91,1_",",803,"I")
IF ZZ'=""
Begin DoDot:1
+3 IF ZZ=1
SET $PIECE(^SD(404.91,1,"PCMM"),"^",3)=0
End DoDot:1
+4 ;run config checks for OIF OEF
IF $$INIT()=0
Begin DoDot:1
+5 DO BMES^XPDUTL("The OIF OEF team is not set up correctly.")
+6 DO MES^XPDUTL("Installation aborted.")
+7 SET XPDABORT=1
End DoDot:1
+8 QUIT
POST ;
+1 DO CLEAN(1)
+2 QUIT
INIT() ;
+1 ;inputs none
+2 ;outputs 0=fail
+3 ; 1=success
+4 SET (DFN,IEN,JJ,TEAM,TIEN,TPOS,TPOSC,TPIEN,TPUR,PUR,ROLE,COUNT,PC,STAT)=""
SET HOLD=0
+5 KILL ^TMP("SCMMT"),^TMP("SCMMR")
+6 ;success/fail team config
NEW SCTFG
+7 ;success/fail role config
NEW SCRFG
+8 SET SCTFG=$$TEAM()
+9 SET SCRFG=$$ROLE()
+10 DO EXIT
+11 QUIT $SELECT(SCTFG=0:0,SCRFG=0:0,1:1)
TEAM() ;
+1 ;if only one active team w/oif oef purp and pc=no count=9
+2 SET TEAM=""
SET COUNT=8
FOR
SET TEAM=$ORDER(^SCTM(404.51,"B",TEAM))
IF TEAM=""
QUIT
Begin DoDot:1
+3 SET TIEN=""
FOR
SET TIEN=$ORDER(^SCTM(404.51,"B",TEAM,TIEN))
IF TIEN=""
QUIT
Begin DoDot:2
+4 DO HISTM
IF STAT'=1
QUIT
+5 SET TPUR=""
SET TPUR=$$GET1^DIQ(404.51,TIEN_",",.03,"E")
+6 IF TPUR["OIF"!(TPUR["OEF")
Begin DoDot:3
+7 SET COUNT=COUNT+1
+8 SET PC=""
SET PC=$$GET1^DIQ(404.51,TIEN_",",.05)
+9 IF PC="YES"
SET COUNT=COUNT+1
+10 SET ^TMP("SCMMT",$JOB,COUNT)="TEAM: "_TEAM
+11 SET COUNT=COUNT+1
SET ^TMP("SCMMT",$JOB,COUNT)="PRIMARY CARE TEAM: "_PC
+12 SET COUNT=COUNT+1
SET ^TMP("SCMMT",$JOB,COUNT)=""
+13 QUIT
End DoDot:3
End DoDot:2
End DoDot:1
+14 ;oif oef team set to pc
IF COUNT>11
DO MESS1
QUIT 0
+15 ;no active oif oef team
IF COUNT=8
DO MESS1
QUIT 0
+16 QUIT 1
ROLE() ;
+1 SET (TEAM,TPUR,ROIF,TOIF,TPOIF,TPHS,TPHN,STAT,TPH,STAT,RIEN,APC)=""
SET CC=6
+2 SET TPOS=""
FOR
SET TPOS=$ORDER(^SCTM(404.57,"B",TPOS))
IF TPOS=""
QUIT
Begin DoDot:1
+3 SET TPIEN=""
FOR
SET TPIEN=$ORDER(^SCTM(404.57,"B",TPOS,TPIEN))
IF TPIEN=""
QUIT
Begin DoDot:2
+4 DO HIST
+5 IF STAT=0
QUIT
+6 SET RIEN=""
SET RIEN=$$GET1^DIQ(404.57,TPIEN_",",.03,"I")
+7 SET ROLE=""
SET ROLE=$$GET1^DIQ(404.57,TPIEN_",",.03,"E")
+8 SET ROIF=""
IF ROLE["OIF"!(ROLE["OEF")
SET ROIF="Y"
+9 SET TEAM=$$GET1^DIQ(404.57,TPIEN_",",.02)
SET TIEN=$$GET1^DIQ(404.57,TPIEN_",",.02,"I")
+10 ;exclude positions on inactive teams
DO HISTM
IF STAT'=1
QUIT
+11 SET (TOIF,TPOIF)=""
SET TPUR=$$GET1^DIQ(404.51,TIEN_",",.03)
IF TPUR["OIF"!(TPUR["OEF")
SET (TOIF,TPOIF)="Y"
+12 SET PPP=$$GET1^DIQ(404.57,TPIEN_",",.04,"E")
+13 DO SAVE
IF SAVE="Y"
Begin DoDot:3
+14 SET CC=CC+1
SET ^TMP("SCMMR",$JOB,CC)=""
+15 SET CC=CC+1
SET ^TMP("SCMMR",$JOB,CC)="TEAM: "_TEAM
+16 SET CC=CC+1
SET ^TMP("SCMMR",$JOB,CC)="TEAM POSITION: "_TPOS
+17 SET CC=CC+1
SET ^TMP("SCMMR",$JOB,CC)="TEAM PURPOSE: "_TPUR
+18 SET CC=CC+1
SET ^TMP("SCMMR",$JOB,CC)="ROLE: "_ROLE
+19 SET CC=CC+1
SET ^TMP("SCMMR",$JOB,CC)="POSSIBLE PRIMARY PRACTITIONER: "_PPP
+20 QUIT
End DoDot:3
End DoDot:2
End DoDot:1
+21 IF CC>6
DO MESS2
QUIT 0
+22 QUIT 1
HIST ;Get TEAM POSITION HISTORY status.
+1 SET (STAT,TPH,TPHN)=""
+2 SET TPHN=""
FOR
SET TPHN=$ORDER(^SCTM(404.59,"B",TPIEN,TPHN))
IF TPHN=""
QUIT
Begin DoDot:1
+3 SET TPH=""
SET STAT=$$GET1^DIQ(404.59,TPHN_",",.03,"I")
+4 SET TPHDT=$$GET1^DIQ(404.59,TPHN_",",.02,"I")
+5 IF TPHDT>DT
SET STAT='STAT
+6 QUIT
End DoDot:1
+7 QUIT
HISTM ;Get TEAM HISTORY status
+1 SET IEN=""
FOR
SET IEN=$ORDER(^SCTM(404.58,"B",TIEN,IEN))
IF IEN=""
QUIT
Begin DoDot:1
+2 SET STAT=$$GET1^DIQ(404.58,IEN_",",.03,"I")
+3 SET THDT=$$GET1^DIQ(404.58,IEN_",",.02,"I")
+4 IF THDT>DT
SET STAT='STAT
End DoDot:1
+5 QUIT
SAVE ;
+1 SET SAVE=""
+2 IF ROIF=""&(TOIF=""&(TPOIF=""))
QUIT
+3 IF ROIF="Y"&(TOIF=""!(TPOIF=""))
SET SAVE="Y"
+4 IF ROIF=""&(TOIF="Y"!(TPOIF="Y"))
SET SAVE="Y"
+5 IF TOIF="Y"&(ROIF=""!(TPOIF=""))
SET SAVE="Y"
+6 IF TOIF=""&(ROIF="Y"!(TPOIF="Y"))
SET SAVE="Y"
+7 IF TPOIF="Y"&(ROIF=""!(TOIF=""))
SET SAVE="Y"
+8 IF TPOIF=""&(ROIF="Y"!(TOIF=""))
SET SAVE="Y"
+9 QUIT
+10 ;
MESS1 ;Create message if more than 1 oif oef team.
+1 SET ^TMP("SCMMT",$JOB,1)="The setup of the OIF OEF team at this site is incorrect."
+2 SET ^TMP("SCMMT",$JOB,2)="The business rules governing PCMM OIF OEF teams state that each"
+3 SET ^TMP("SCMMT",$JOB,3)="site can have only one OIF OEF team. That team cannot provide primary care."
+4 SET ^TMP("SCMMT",$JOB,4)="Please correct errors as soon as possible; you will continue "
+5 SET ^TMP("SCMMT",$JOB,5)="to receive this message until all errors are resolved."
+6 SET ^TMP("SCMMT",$JOB,6)=""
+7 SET ^TMP("SCMMT",$JOB,7)="THE FOLLOWING IS A LIST OF OIF OEF TEAMS AT THIS INSTITUTION:"
+8 SET ^TMP("SCMMT",$JOB,8)=""
+9 NEW XMSUB,XMY,XMTEST,XMDUZ
+10 SET XMSUB="PCMM OIF OEF TEAMS"
+11 SET XMY("G.PCMM HL7 MESSAGES")=""
+12 SET XMTEXT="^TMP(""SCMMT"",$J,"
+13 DO ^XMD
+14 SET HOLD="Y"
+15 QUIT
MESS2 ;Create message for bad entries involving oif oef teams.
+1 SET ^TMP("SCMMR",$JOB,1)="The PCMM TEAM POSITIONS listed below have inconsistencies"
+2 SET ^TMP("SCMMR",$JOB,2)="in the set up of OIF OEF Teams and Positions in the PCMM package."
+3 SET ^TMP("SCMMR",$JOB,3)="Please review the business rules pertaining to the set up of"
+4 SET ^TMP("SCMMR",$JOB,4)="OIF OEF Teams and Positions. The PCMM HL7 Transmission will not"
+5 SET ^TMP("SCMMR",$JOB,5)="transmit until these errors are corrected. If additional assistance"
+6 SET ^TMP("SCMMR",$JOB,6)="is needed please contact the national helpdesk."
+7 NEW XMSUB,XMY,XMTEST,XMDUZ
+8 SET XMSUB="PCMM OIF OEF ERROR MESSAGE"
+9 SET XMY("G.PCMM HL7 MESSAGES")=""
+10 SET XMTEXT="^TMP(""SCMMR"",$J,"
+11 DO ^XMD
+12 SET HOLD="Y"
+13 QUIT
CLEAN(SCOIFG) ;clean up errors in transmission log
+1 ;inputs
+2 ; 0=bad OIF OEF config
+3 ; 1=good OIF OEF config
+4 ;
+5 ;error profile
+6 ; patient=null
+7 ; practitioner=null
+8 ; status=rj
+9 ; ZPC ID exists
+10 ;
+11 NEW SCI,SCJ,SCK,SCA,DFN,SC1
+12 ;0 node 404.471
NEW SC0
+13 ;0 node 404.43
NEW SC043
+14 ;counters
NEW SCT,SCT1,SCT2
+15 ;position ien
NEW SCTP
+16 ;return value
NEW SCEPS
+17 ;return value
NEW SCSTAT
+18 ;error text
NEW SCERR
+19 ;array of ZPC segments
NEW SCARRAY
+20 ;ien 404.47141
NEW SCIENS
+21 ;;;
+22 SET (SC043,SCK,SCT,SCT1,SCT2)=0
+23 DO BMES^XPDUTL("Cleaning PCMM Transmission Log")
+24 FOR SCI=0:0
SET SCI=$ORDER(^SCPT(404.471,"ASTAT","RJ",SCI))
IF SCI'>0
QUIT
Begin DoDot:1
+25 ;get 0 node
SET SC0=$GET(^SCPT(404.471,SCI,0))
+26 ;exclude
IF (+$PIECE(SC0,U,2)_U_(+$PIECE(SC0,U,8)))'="0^0"
QUIT
+27 SET SCA=0
FOR SCK=0:0
SET SCK=$ORDER(^SCPT(404.471,SCI,"ZPC",SCK))
IF SCK=""!(+SCA>0)
QUIT
Begin DoDot:2
+28 SET SCIENS=SCK_","_SCI
SET SCA=+($$GET1^DIQ(404.47141,SCIENS,.02))
End DoDot:2
+29 ;exclude if no ZPC ID
IF SCA=0
QUIT
+30 SET SC043=$GET(^SCPT(404.43,SCA,0))
+31 ;close log entry
+32 FOR SCK=0:0
SET SCK=$ORDER(^SCPT(404.471,SCI,"ERR",SCK))
IF SCK'>0
QUIT
Begin DoDot:2
+33 SET SCEPS=$$UPDEPS^SCMCHLA(SCI,SCK,2,.SCERR)
End DoDot:2
+34 SET SCSTAT=$$UPDSTAT^SCMCHLA(SCI,"RT",.SCERR)
+35 IF SCERR'=""
Begin DoDot:2
+36 SET SCT2=SCT2+1
+37 SET SCARRAY(SCI)=SCERR
End DoDot:2
QUIT
+38 SET SCT1=SCT1+1
IF SCT1\5
WRITE "."
+39 ;stop processing log entries with no 404.43
IF SC043=0
QUIT
+40 SET DFN=+$PIECE($GET(^SCPT(404.42,+SC043,0)),U)
+41 SET SCTP=+$PIECE(SC043,U,2)
+42 ;only re-send if good 404.43 record and no OIF OEF errors
+43 IF DFN>0&(SCOIFG)
Begin DoDot:2
+44 DO ADD^SCMCHLE("NOW",+SCA_";SCPT(404.43,",DFN,SCTP)
+45 SET SCT=SCT+1
End DoDot:2
End DoDot:1
+46 IF SCT_U_SCT1'=(0_U_0)
DO MSG(SCT_U_SCT1_U_SCT2,.SCARRAY)
+47 KILL ^TMP("SCOIF",$JOB)
+48 QUIT
MSG(SC1,SCARRAY) ;
+1 ;inputs
+2 NEW XMY,XMDUZ,XMSUB,XMTEXT
+3 NEW SCIX,SCI
+4 SET XMDUZ="PCMM Module"
+5 SET XMY("G.PCMM HL7 MESSAGES")=""
+6 SET XMSUB="PCMM Transmission Log Clean Up"
+7 SET XMTEXT="^TMP(""SCOIF"",$J,"
+8 KILL ^TMP("SCOIF",$JOB)
+9 SET ^TMP("SCOIF",$JOB,1)=""
+10 SET ^TMP("SCOIF",$JOB,2)="Number of transmission log entries that were closed: "_+$PIECE(SC1,U,2)
+11 SET ^TMP("SCOIF",$JOB,3)="Number of OIF OEF patient assignments that will be re-transmitted: "_+$PIECE(SC1,U)
+12 SET ^TMP("SCOIF",$JOB,4)=""
+13 IF +$PIECE(SC1,U,3)
Begin DoDot:1
+14 SET ^TMP("SCOIF",$JOB,5)="The following transmission log entries could not be closed: "
+15 SET ^TMP("SCOIF",$JOB,6)="IEN"_$JUSTIFY(" ",7)_"Msg ID"_$JUSTIFY(" ",11)_"Error"
+16 SET SCI=""
FOR SCIX=7:1
SET SCI=$ORDER(SCARRAY(SCI))
IF SCI=""
QUIT
Begin DoDot:2
+17 SET ^TMP("SCOIF",$JOB,SCIX)=SCI_$JUSTIFY(" ",10-$LENGTH(SCI))_$$GET1^DIQ(404.471,SCI,.01,"E")_$JUSTIFY(" ",7)_SCARRAY(SCI)
+18 SET ^TMP("SCOIF",$JOB,SCIX+1)=""
End DoDot:2
End DoDot:1
+19 DO ^XMD
+20 QUIT
EXIT ;End routine
+1 KILL DFN,IEN,JJ,TEAM,TIEN,TPOS,TPOSC,TPIEN,TPUR,PUR,ROLE,COUNT
+2 KILL TEAM,TPUR,TIEN,ROIF,TOIF,TPOIF,TPHS,TPHN,STAT,RIEN,APC
+3 KILL CC,PC,PPP,SAVE,THDT,TPH,TPHDT,XMTEXT,HOLD,IENS
+4 KILL ^TMP("SCMMT",$JOB),^TMP("SCMMR",$JOB)
+5 QUIT
