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

AMHGECOM.m

Go to the documentation of this file. 
  1. AMHGECOM ; IHS/CMI/MAW - AMHG Community Add/Edits 3/6/2009 5:57:06 PM ;
  1.  ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
  1.  ;
  1.  ;
  1.  ;
  1.  ;
  1. DEBUG(RETVAL,AMHSTR) ;-- debug entry point
  1.  D DEBUG^%Serenji("EP^AMHGD(RETVAL,.AMHSTR)")
  1.  Q
  1.  ;
  1. MODV(AMHIEN,DM,REC,PP,PRO,TOC,ST,AT,NS,TGT,EDT,LOC,COM,AC,LSS,FLG,CLN) ;EP -- add/update MHSS RECORD entry
  1.  N AMHFDA,AMHIENS,AMHERRR,AMHREC
  1.  S AMHIENS=$S(DM="A":"+1,",1:REC_",")
  1.  S AMHFDA(9002011,AMHIENS,.02)=PRO
  1.  S AMHFDA(9002011,AMHIENS,.04)=LOC
  1.  S AMHFDA(9002011,AMHIENS,.05)=COM
  1.  S AMHFDA(9002011,AMHIENS,.06)=AC
  1.  S AMHFDA(9002011,AMHIENS,.07)=TOC
  1.  S AMHFDA(9002011,AMHIENS,.09)=NS
  1.  S AMHFDA(9002011,AMHIENS,.12)=AT
  1.  S AMHFDA(9002011,AMHIENS,.19)=DUZ
  1.  S AMHFDA(9002011,AMHIENS,.25)=CLN
  1.  S AMHFDA(9002011,AMHIENS,.27)=FLG
  1.  S AMHFDA(9002011,AMHIENS,.31)=LSS
  1.  S AMHFDA(9002011,AMHIENS,.33)="R"
  1.  S AMHFDA(9002011,AMHIENS,1106)=TGT
  1.  S AMHFDA(9002011,AMHIENS,1111)=1
  1.  I DM="A" D  Q
  1.  . S AMHFDA(9002011,AMHIENS,.01)=EDT
  1.  . S AMHFDA(9002011,AMHIENS,.03)=DT
  1.  . ;S AMHFDA(9002011,AMHIENS,.17)="A"
  1.  . S AMHFDA(9002011,AMHIENS,.19)=DUZ
  1.  . S AMHFDA(9002011,AMHIENS,.22)="A"
  1.  . S AMHFDA(9002011.5101,"+2,"_AMHIENS,.01)=$$NOW^XLFDT
  1.  . S AMHFDA(9002011.5101,"+2,"_AMHIENS,.02)=DUZ
  1.  . D UPDATE^DIE("","AMHFDA","AMHIENS","AMHERRR(1)")
  1.  . I $D(AMHERRR) S AMHER="0~Add Visit"
  1.  . S AMHIEN=+$G(AMHIENS(1))
  1.  . D MODPRV^AMHGEVF(PP,DM,AMHIEN,"","P")
  1.  I DM="E" D  Q
  1.  . S AMHIENS(1)=REC
  1.  . ;S AMHFDA(9002011,AMHIENS,.17)="E"
  1.  . S AMHFDA(9002011,AMHIENS,.21)=DT
  1.  . S AMHFDA(9002011,AMHIENS,.22)="M"
  1.  . S AMHFDA(9002011,AMHIENS,.28)=DUZ
  1.  . D FILE^DIE("K","AMHFDA","AMHERRR(1)")
  1.  . I $D(AMHERRR) S AMHER="0~Edit Visit"
  1.  . S AMHIEN=REC
  1.  . D MODPRV^AMHGEVF(PP,DM,AMHIEN,"","P")
  1.  . D VAUD(REC)  ;update the audit log
  1.  Q
  1.  ;
  1. VAUD(RC) ;-- update the audit log
  1.  N AMHFDA,AMHIENS,AMHERRR
  1.  S AMHIENS=""
  1.  S AMHFDA(9002011,RC_",",.21)=DT
  1.  S AMHFDA(9002011,RC_",",.28)=DUZ
  1.  S AMHFDA(9002011.5101,"+2,"_RC_",",.01)=$$NOW^XLFDT
  1.  S AMHFDA(9002011.5101,"+2,"_RC_",",.02)=DUZ
  1.  D UPDATE^DIE("","AMHFDA","AMHIENS","AMHERRR(1)")
  1.  Q
  1.  ;
  1. POV(D,RC,P,A2) ;EP -- add/modify pov
  1.  N AMHDA,R
  1.  S R="~"
  1.  S AMHDA=0 F  S AMHDA=$O(A2(AMHDA)) Q:'AMHDA  D
  1.  . N STR,PIEN,PCODE,PNARR
  1.  . S STR=$G(A2(AMHDA))
  1.  . S PIEN=$P(STR,R)
  1.  . S PCODE=$P(STR,R,2)
  1.  . S PNARR=$P(STR,R,3)
  1.  . I $G(PNARR)]"" D
  1.  ..S AMHN=$$FNDNARR^AMHGU(PNARR,1)
  1.  . I D="A" D ADDPOV^AMHGEVF(PIEN,P,RC,AMHN) Q
  1.  . I D="E" D  Q
  1.  .. N AMHPREC
  1.  .. S AMHPREC=$$FNDPOV^AMHGU(PIEN,RC)
  1.  .. I 'AMHPREC D ADDPOV^AMHGEVF(PIEN,P,RC,AMHN) Q
  1.  .. D EDITPOV^AMHGEVF(AMHPREC,AMHN)
  1.  I D="E" D  Q
  1.  . D DELPOV^AMHGEVF(RC,.A2)
  1.  Q
  1.  ;
  1. MODPA(PI,PAT,RC,OTH) ;EP -- add a prevention activity
  1.  Q:$$FNDPA^AMHGU(RC,PI)
  1.  N AMHFDA,AMHIENS,AMHERRR,AMHPIEN
  1.  S AMHIENS="+1,"
  1.  S AMHFDA(9002011.09,AMHIENS,.01)=PI
  1.  S AMHFDA(9002011.09,AMHIENS,.02)=PAT
  1.  S AMHFDA(9002011.09,AMHIENS,.03)=RC
  1.  S AMHFDA(9002011.09,AMHIENS,.04)=OTH
  1.  D UPDATE^DIE("","AMHFDA","AMHIENS","AMHERRR(1)")
  1.  I $D(AMHERRR) S AMHER="0~Add Prevention Activity"
  1.  S AMHPIEN=$G(AMHIENS(1))
  1.  Q
  1.  ;
  1. DELPA(REC,PAC) ;EP -- check to see if any cpt records were deleted during edit
  1.  N ADA,R,PA
  1.  S R="~"
  1.  S ADA=0 F  S ADA=$O(PAC(ADA)) Q:'ADA  D
  1.  . N PAIEN
  1.  . S PAIEN=$P(PAC(ADA),R)
  1.  . S P(PAIEN)=PAIEN
  1.  N IEN
  1.  S IEN=0 F  S IEN=$O(^AMHRPA("AD",REC,IEN)) Q:'IEN  D
  1.  . N PAI
  1.  . S PAI=$P(^AMHRPA(IEN,0),U)
  1.  . I '$G(P(PAI)) D
  1.  .. S DIK="^AMHRPA(",DA=IEN D ^DIK
  1.  Q
  1.  ;