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

BDMGEB.m

Go to the documentation of this file. 
  1. BDMGEB ; cmi/anch/maw - BDM DMS GUI Filing Routine ;
  1.  ;;2.0;BDM DIABETES MANAGEMENT SYSTEM;**1**;JAN 17, 2008
  1.  ;
  1.  ;
  1.  ;
  1.  ;1/25/2005 added in REGSV a check for DX
  1.  ;3/22/2006 added diagnosis save to complications list add, subroutine CMPA
  1.  ;
  1. DEBUG(BDMRET,BDMSTR) ;-- debugger
  1.  D DEBUG^%Serenji("DME^BDMGE(.BDMRET,.BDMSTR)")
  1.  Q
  1.  ;
  1. CMPL(BDMRET,BDMSTR) ;-- save complications list
  1.  N P,BDMDA,BDMIEN,BDMREG,BDMREGE,BDMCL,BDMCNT
  1.  S P="|"
  1.  K ^BDMTMP($J)
  1.  S BDMRET="^BDMTMP("_$J_")"
  1.  S ^BDMTMP($J,0)="T00050RETURN"_$C(30)
  1.  I $G(BDMSTR)="" D CATSTR^BDMGU(.BDMSTR,.BDMSTR)
  1.  S BDMREGE=$P(BDMSTR,P)
  1.  S BDMCNT=0
  1.  S BDMREG=$O(^ACM(41.1,"B",BDMREGE,0))
  1.  I $P(BDMSTR,P,2)="" D  Q
  1.  . N BDMDA
  1.  . S BDMDA=0 F  S BDMDA=$O(^ACM(42.1,"RG",BDMREG,BDMDA)) Q:'BDMDA  D
  1.  .. N BDMIEN
  1.  .. S BDMIEN=0 F  S BDMIEN=$O(^ACM(42.1,"RG",BDMREG,BDMDA,BDMIEN)) Q:'BDMIEN  D
  1.  ... S DA(1)=BDMDA,DA=BDMIEN,DIK="^ACM(42.1,"_DA(1)_",""RG"","
  1.  ... D ^DIK
  1.  F I=2:1 D  Q:$P(BDMSTR,P,I)=""
  1.  . Q:$P(BDMSTR,P,I)=""
  1.  . S BDMCNT=BDMCNT+1
  1.  . S BDMCL(BDMCNT)=$P(BDMSTR,P,I)
  1.  D CLNCL(.BDMCL,BDMREG)
  1.  D ADDCL(.BDMCL,BDMREG)
  1.  S ^BDMTMP($J,1)=$C(31)_$G(BDMERR)
  1.  Q
  1.  ;
  1. CMPA(BDMRET,BDMSTR) ;-- add complication to list
  1.  N P,BDMDA,BDMIEN,BDMREG,BDMREGE,BDMCL,BDMICD
  1.  S P="|"
  1.  K ^BDMTMP($J)
  1.  S BDMRET="^BDMTMP("_$J_")"
  1.  S ^BDMTMP($J,0)="T00050Error"_$C(30)
  1.  I $G(BDMSTR)="" D CATSTR^BDMGU(.BDMSTR,.BDMSTR)
  1.  S BDMREG=$P(BDMSTR,P)
  1.  S BDMCL=$P(BDMSTR,P,2)
  1.  S BDMCNT=0
  1.  D ADDCL(BDMCL,BDMREG)
  1.  S ^BDMTMP($J,2)=$C(31)_$G(BDMERR)
  1.  Q
  1.  ;
  1. CMPDXA(BDMRET,BDMSTR) ;-- add complication diagnosis to list
  1.  N P,BDMDA,BDMIEN,BDMREG,BDMREGE,BDMCL,BDMICD
  1.  S P="|"
  1.  K ^BDMTMP($J)
  1.  S BDMRET="^BDMTMP("_$J_")"
  1.  S ^BDMTMP($J,0)="T00050RETURN"_$C(30)
  1.  I $G(BDMSTR)="" D CATSTR^BDMGU(.BDMSTR,.BDMSTR)
  1.  S BDMREG=$P(BDMSTR,P)
  1.  S BDMCL=$P(BDMSTR,P,2)
  1.  S BDMICD=$P(BDMSTR,P,3)
  1.  S BDMCNT=0
  1.  D ADDCLDX(BDMCL,BDMICD)
  1.  S ^BDMTMP($J,1)=$C(31)_$G(BDMERR)
  1.  Q
  1.  ;
  1. CLNCL(CL,REG) ;-- clean up deleted complications first
  1.  N BDMDA,BDMIEN,BDMCL
  1.  S BDMDA=0 F  S BDMDA=$O(CL(BDMDA)) Q:'BDMDA  D
  1.  . S BDMCL=$G(CL(BDMDA))
  1.  . S BDMCLI=$O(^ACM(42.1,"B",BDMCL,0))
  1.  . I BDMCLI,$D(^ACM(42.1,"RG",REG,BDMCL)) K CL(BDMDA)
  1.  N BDMDA
  1.  S BDMDA=0 F  S BDMDA=$O(CL(BDMDA)) Q:'BDMDA  D
  1.  . N BDMCL,BDMIEN
  1.  . S BDMCL=$G(CL,BDMDA)
  1.  . S BDMCLI=$O(^ACM(42.1,"B",BDMCL,0))
  1.  . Q:'BDMCLI
  1.  . S BDMIEN=$O(^ACM(42.1,"RG",REG,BDMCLI,0))
  1.  . Q:'BDMIEN
  1.  . S DA(1)=BDMCLI,DA=BDMIEN,DIK="^ACM(42.1,"_DA(1)_",""RG"","
  1.  . D ^DIK
  1.  Q
  1.  ;
  1. ADDCL(CL,REG) ;-- add new complications to the complications list
  1.  N BDMDA,BDMIEN,BDMCL
  1.  S BDMCL=CL
  1.  S BDMCLI=$O(^ACM(42.1,"B",BDMCL,0))
  1.  I 'BDMCLI D  Q
  1.  . N BDMFDA,BDMIENS,BDMERR
  1.  . S BDMIENS=""
  1.  . S BDMFDA(9002242.1,"?+1,",.01)=BDMCL
  1.  . S BDMFDA(9002242.11,"+2,?+1,",.01)=REG
  1.  . D UPDATE^DIE("","BDMFDA","BDMIENS","BDMERR(1)")
  1.  . S ^BDMTMP($J,1)=$G(BDMIENS(1))_$C(30)
  1.  I '$D(^ACM(42.1,"RG",REG,BDMCL)) D  Q
  1.  . N BDMFDA,BDMIENS,BDMERR
  1.  . S BDMIENS(1)=BDMCLI
  1.  . S BDMFDA(9002242.11,"+2,"_BDMIENS(1)_",",.01)=REG
  1.  . D UPDATE^DIE("","BDMFDA","BDMIENS","BDMERR(1)")
  1.  S ^BDMTMP($J,1)=BDMCLI_$C(30)
  1.  Q
  1.  ;
  1. ADDCLDX(CL,ICD) ;-- add new complications diagnosis to the complication
  1.  N BDMDA,BDMIEN,BDMCL
  1.  N I,R
  1.  S R="~"
  1.  F I=1:1 D  Q:$P(ICD,R,I)=""
  1.  . Q:$P(ICD,R,I)=""
  1.  . N BDMICDI
  1.  . S BDMICDI=$P(ICD,R,I)
  1.  . N BDMFDA,BDMIENS,BDMERR
  1.  . S BDMIENS="?+2,"_CL_","
  1.  . S BDMFDA(9002242.11101,BDMIENS,.01)=BDMICDI
  1.  . D UPDATE^DIE("","BDMFDA","BDMIENS","BDMERR(1)")
  1.  . Q
  1.  Q
  1.  ;
  1. NLET(BDMRET,BDMSTR) ;-- save the new letter definition in RPMS
  1.  N P,BDMDIR,BDMFN
  1.  S P="|"
  1.  S BDMDIR=$P(BDMSTR,P)
  1.  S BDMFN=$P(BDMSTR,P,2)
  1.  N BDMFDA,BDMERR,BDMIENS,BDMI
  1.  S BDMIENS=""
  1.  S BDMRET="^BDMTMP("_$J_")"
  1.  S BDMI=0
  1.  S ^BDMTMP($J,BDMI)="T00009BMXIEN"_$C(30)
  1.  I $O(^BDMLET("B",BDMFN,0)) D  Q
  1.  . S ^BDMTMP($J,BDMI+1)="Letter Already Exists"_$C(31)
  1.  S BDMFDA(9003201,"+1,",.01)=BDMFN
  1.  S BDMFDA(9003201,"+1,",.02)=DUZ
  1.  S BDMFDA(9003201,"+1,",.03)=DT
  1.  S BDMFDA(9003201,"+1,",.04)=BDMDIR
  1.  S BDMFDA(9003201,"+1,",.05)=$TR(BDMFN,"/")_".doc"
  1.  D UPDATE^DIE("","BDMFDA","BDMIENS","BDMERR(1)")
  1.  S ^BDMTMP($J,BDMI+1)=$G(BDMIENS(1))_$C(31)
  1.  Q
  1.  ;
  1. LETE(BDMRET,BDMSTR) ;-- add directory/filename to letter
  1.  N P,BDMDIR,BDMIEN
  1.  S P="|"
  1.  S BDMIEN=$P(BDMSTR,P)
  1.  S BDMDIR=$P(BDMSTR,P,2)
  1.  N BDMFDA,BDMERR,BDMIENS,BDMI
  1.  S BDMIENS=BDMIEN_","
  1.  S BDMRET="^BDMTMP("_$J_")"
  1.  S BDMI=0
  1.  S ^BDMTMP($J,BDMI)="T00009BMXIEN"_$C(30)
  1.  N BDMFN
  1.  S BDMFN=$P($G(^BDMLET(BDMIEN,0)),U)
  1.  S BDMFDA(9003201,BDMIENS,.04)=BDMDIR
  1.  S BDMFDA(9003201,BDMIENS,.05)=$TR(BDMFN,"/")_".doc"
  1.  D FILE^DIE("K","BDMFDA","BDMERR(1)")
  1.  S ^BDMTMP($J,BDMI+1)=$G(BDMIENS(1))_$C(31)
  1.  Q
  1.  ;
  1. LETP(BDMRET,BDMSTR) ;-- save letter insert items
  1.  N P,BDMLETI,BDMITEM,R
  1.  S P="|",R="~"
  1.  S BDMLETI=$P(BDMSTR,P)
  1.  S BDMITEM=$P(BDMSTR,P,2)
  1.  N BDMI
  1.  S BDMRET="^BDMTMP("_$J_")"
  1.  S BDMI=0
  1.  S ^BDMTMP($J,BDMI)="T00009BMXIEN"_$C(30)
  1.  ;S BDMLETI=$O(^BDMLET("B",BDMLET,0))
  1.  N BDMDA
  1.  S BDMDA=0 F  S BDMDA=$O(^BDMLET(BDMLETI,"ITEM",BDMDA)) Q:'BDMDA  D
  1.  . S DA(1)=BDMLETI,DA=BDMDA,DIK="^BDMLET("_DA(1)_","_"""ITEM"""_","
  1.  . D ^DIK
  1.  N I
  1.  F I=2:1 D  Q:$P(BDMITEM,R,I)=""
  1.  . N BDMFDA,BDMERR,BDMIENS
  1.  . Q:$P(BDMITEM,R,I)=""
  1.  . S BDMIENS(1)=BDMLETI
  1.  . S BDMIENS="?+2,"_BDMLETI_","
  1.  . N BDMIT,BDMITI
  1.  . S BDMIT=$P(BDMITEM,R,I)
  1.  . S BDMITI=$O(^DD("FUNC","B",BDMIT,0))
  1.  . S BDMFDA(9003201.02,BDMIENS,.01)=BDMITI
  1.  . D UPDATE^DIE("","BDMFDA","BDMIENS","BDMERR(1)")
  1.  S ^BDMTMP($J,BDMI+1)=$G(BDMIENS(1))_$C(31)
  1.  Q
  1.  ;