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

AMHGETP.m

Go to the documentation of this file. 
  1. AMHGETP ; IHS/CMI/MAW - AMHG Treatment Plan Add/Edits 3/7/2009 8:49:18 PM ;
  1.  ;;4.0;IHS BEHAVIORAL HEALTH;**1**;JUN 18, 2010;Build 8
  1.  ;
  1.  ;
  1.  ;
  1. DEBUG(RETVAL,AMHSTR) ;-- debug entry point
  1.  D DEBUG^%Serenji("EP^AMHGD(RETVAL,.AMHSTR)")
  1.  Q
  1.  ;
  1. TP(AMHIEN,DM,REC,PAT,DE,PRG,TD,RD,DC,DP,A5,CA,CD,DS,PRBL,GAF,PP) ;EP -- file the treatment plan
  1.  N AMHIENS,AMHFDA,AMHERRR,FL
  1.  S AMHIENS=$S(DM="A":"+1,",1:REC_",")
  1.  S FL=9002011.56
  1.  S AMHFDA(FL,AMHIENS,.03)=TD
  1.  S AMHFDA(FL,AMHIENS,.04)=DP
  1.  S AMHFDA(FL,AMHIENS,.05)=DS
  1.  S AMHFDA(FL,AMHIENS,.06)=CD
  1.  S AMHFDA(FL,AMHIENS,.09)=RD
  1.  S AMHFDA(FL,AMHIENS,.12)=DC
  1.  S AMHFDA(FL,AMHIENS,.16)=CA
  1.  S AMHFDA(FL,AMHIENS,.17)=PRG
  1.  S AMHFDA(FL,AMHIENS,1601)=A5
  1.  S AMHFDA(FL,AMHIENS,1101)=PRBL
  1.  S AMHFDA(FL,AMHIENS,1602)=GAF
  1.  I DM="A" D
  1.  . S AMHFDA(FL,AMHIENS,.01)=DE
  1.  . S AMHFDA(FL,AMHIENS,.02)=PAT
  1.  . D UPDATE^DIE("","AMHFDA","AMHIENS","AMHERRR(1)")
  1.  . I '$D(AMHERRR) S AMHIEN=$G(AMHIENS(1)) Q
  1.  . S AMHER="0~Add Treatment Plan"
  1.  I DM="E" D
  1.  . S AMHFDA(FL,AMHIENS,.01)=DE
  1.  . D FILE^DIE("K","AMHFDA","AMHERRR(1)")
  1.  . I '$D(AMHERRR) S AMHIEN=REC Q
  1.  . S AMHER="0~Edit Treatment Plan"
  1.  I $D(PP) D PPART(AMHIEN,.PP)
  1.  Q
  1. ADDAXIS4(PI,RC) ;EP -- add axis 4
  1.  N AMHFDA,AMHIENS,AMHERRR,AMHAIEN
  1.  S AMHIENS="+2,"_RC_","
  1.  S AMHFDA(9002011.569,AMHIENS,.01)=PI
  1.  D UPDATE^DIE("","AMHFDA","AMHIENS","AMHERRR(1)")
  1.  I $D(AMHERRR) S AMHER="0~Add Axis IV"
  1.  I '$D(AMHERRR) S AMHAIEN=$G(AMHIENS(1))
  1.  Q
  1.  ;
  1. DELAXIS4(REC,A4) ;EP -- check to see if any axis 4 records were deleted during edit
  1.  N ADA,R,A
  1.  S R="~"
  1.  S ADA=0 F  S ADA=$O(A4(ADA)) Q:'ADA  D
  1.  . N A4IEN
  1.  . S A4IEN=$P(A4(ADA),R)
  1.  . S A(A4IEN)=A4IEN
  1.  N IEN
  1.  S IEN=0 F  S IEN=$O(^AMHPTXP(REC,9,IEN)) Q:'IEN  D
  1.  . N AXIS4
  1.  . S AXIS4=$P(^AMHPTXP(REC,9,IEN,0),U)
  1.  . I '$G(A(AXIS4)) D
  1.  .. S DA(1)=REC,DA=IEN,DIK="^AMHPTXP("_DA(1)_",9," D ^DIK
  1.  Q
  1.  ;
  1. A(RC,A,FLD) ;EP -- file wp fields
  1.  ;Q:$G(A)=""
  1.  N AMHWP
  1.  D ARRAYT^AMHGU(.AMHWP,A)  ;parse the text into an array
  1.  N AMHFDA,AMHIENS,AMHERRR
  1.  S AMHIENS=RC_","
  1.  D WP^AMHGU(.AMHERRR,9002011.56,AMHIENS,FLD,.AMHWP)
  1.  Q
  1.  ;
  1. RD(REC,D,DP,DS) ;EP -- file review data
  1.  D CLNRV(REC)
  1.  N RDA,R
  1.  S R="~"
  1.  S RDA=0 F  S RDA=$O(D(RDA)) Q:'RDA  D
  1.  . N RSTR,RRD,RRP,RRS,RNRD,RRPI,RRSI
  1.  . S RSTR=$G(D(RDA))
  1.  . S RRD=$P(RSTR,R)
  1.  . S RRP=$P(RSTR,R,2)
  1.  . S RRPI=$S($G(RRP)]"":$O(^VA(200,"B",RRP,0)),1:"")
  1.  . S RRS=$P(RSTR,R,3)
  1.  . S RRSI=$S($G(RRS)]"":$O(^VA(200,"B",RRS,0)),1:"")
  1.  . S RNRD=$P(RSTR,R,4)
  1.  . N AMHFDA,AMHIENS,AMHERRR,FL,AMHRDIEN
  1.  . S FL=9002011.564101
  1.  . S AMHIENS="+2,"_REC_","
  1.  . S AMHIENS(2)=RRD
  1.  . S AMHFDA(FL,AMHIENS,.01)=RRD
  1.  . S AMHFDA(FL,AMHIENS,.02)=RNRD
  1.  . S AMHFDA(FL,AMHIENS,.03)=RRPI
  1.  . S AMHFDA(FL,AMHIENS,.04)=RRSI
  1.  . D UPDATE^DIE("","AMHFDA","AMHIENS","AMHERRR(1)")
  1.  . I '$D(AMHERRR) S AMHRDIEN=$G(AMHIENS(2))
  1.  . I $G(DP(RDA))]"",$E(DP(RDA),1,1)'=" " D PART(REC,AMHRDIEN,.DP,RDA)
  1.  . I $G(DS(RDA))]"",$E(DS(RDA),1,1)'=" " D PS(REC,AMHRDIEN,1,DS(RDA))
  1.  Q
  1.  ;
  1. PART(RC,DIEN,DP,RA) ;-- file the participants
  1.  N PFL
  1.  ;Q:$E(DP(DIEN),1,1)=" "
  1.  S PFL=9002011.574112
  1.  N PDA,I
  1.  F I=1:1 D  Q:$P(DP(RA),"&",I)=""
  1.  . Q:$P(DP(RA),"&",I)=""
  1.  . N PSTR,PART,REL
  1.  . S PSTR=$P(DP(RA),"&",I)
  1.  . S PART=$P(PSTR,"~")
  1.  . S REL=$P(PSTR,"~",2)
  1.  . N AMHPFDA,AMHPERR,AMHPIENS
  1.  . S AMHPIENS="+3,"_DIEN_","_RC_","
  1.  . S AMHPFDA(PFL,AMHPIENS,.01)=PART
  1.  . S AMHPFDA(PFL,AMHPIENS,.02)=REL
  1.  . D UPDATE^DIE("","AMHPFDA","AMHPIENS","AMHPERR(1)")
  1.  . I '$D(AMHPERR) S AMHPIEN=$G(AMHIENS(3))
  1.  Q
  1.  ;
  1. PPART(RC,PP) ;-- file the plan participants
  1.  D CLNPP(RC)
  1.  N PFL
  1.  ;Q:$E(DP(DIEN),1,1)=" "
  1.  S PFL=9002011.561701
  1.  N PDA,I
  1.  S PDA=0 F  S PDA=$O(PP(PDA)) Q:'PDA  D
  1.  . N PSTR,PART,REL
  1.  . S PSTR=$G(PP(PDA))
  1.  . S PART=$P(PSTR,"~")
  1.  . S REL=$P(PSTR,"~",2)
  1.  . N AMHPFDA,AMHPERR,AMHPIENS
  1.  . S AMHPIENS="+2,"_RC_","
  1.  . S AMHPFDA(PFL,AMHPIENS,.01)=PART
  1.  . S AMHPFDA(PFL,AMHPIENS,.02)=REL
  1.  . D UPDATE^DIE("","AMHPFDA","AMHPIENS","AMHPERR(1)")
  1.  . I '$D(AMHPERR) S AMHPIEN=$G(AMHIENS(2))
  1.  Q
  1.  ;
  1. PS(RC,DIEN,FLD,DS) ;-- file the progress summary
  1.  ;TODO nned to find out how to file a WP field in a subfile
  1.  S AMHIENS(2)=DIEN
  1.  S AMHIENS(1)=RC
  1.  Q:$G(DS)=""
  1.  N AMHWP
  1.  D ARRAYT^AMHGU(.AMHWP,DS)  ;parse the text into an array
  1.  ;N AMHSFDA,AMHSIENS,AMHSERR
  1.  N PSDA,CNT
  1.  S CNT=0
  1.  S PSDA=0 F  S PSDA=$O(AMHWP(PSDA)) Q:'PSDA  D
  1.  . S CNT=CNT+1
  1.  . S ^AMHPTXP(RC,41,DIEN,1,PSDA,0)=$G(AMHWP(PSDA))
  1.  S ^AMHPTXP(RC,41,DIEN,1,0)="^^"_CNT_"^"_CNT_"^"_DIEN_"^"
  1.  ;S AMHSIENS="+3,"_DIEN_","_RC_","
  1.  ;D WP^AMHGU(.AMHERRR,9002011.56411,AMHIENS,FLD,.AMHWP)
  1.  Q
  1.  ;
  1. CLNPP(RC) ;-- clean out plan participants
  1.  S DA(1)=RC
  1.  S DIK="^AMHPTXP("_DA(1)_",17,"
  1.  N PDA
  1.  S PDA=0 F  S PDA=$O(^AMHPTXP(RC,17,PDA)) Q:'PDA  D
  1.  . S DA=PDA
  1.  . D ^DIK
  1.  Q
  1.  ;
  1. CLNRV(RC) ;clean out the review data first
  1.  S DA(1)=RC
  1.  S DIK="^AMHPTXP("_DA(1)_",41,"
  1.  N TDA
  1.  S TDA=0 F  S TDA=$O(^AMHPTXP(RC,41,TDA)) Q:'TDA  D
  1.  . S DA=TDA
  1.  . D ^DIK
  1.  Q
  1.  ;