- 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