Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SD53P504

SD53P504.m

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