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

GMTSRM.m

Go to the documentation of this file.
  1. GMTSRM ; SLC/KER - Edit HS Type ; 01/06/2003
  1. ;;2.7;Health Summary;**30,35,29,47,56,58**;Oct 20, 1995
  1. ;
  1. ; External References
  1. ; DBIA 10076 ^XUSEC(
  1. ; DBIA 10076 ^XUSEC("GMTSMGR"
  1. ; DBIA 10018 ^DIE
  1. ; DBIA 10010 EN1^DIP
  1. ; DBIA 10026 ^DIR
  1. ;
  1. MAIN ; Main loop to modify multiple health summary types
  1. N %,DTOUT,DUOUT,DIRUT,EXISTS,GMTSFUNC,GMTSQIT,P
  1. S GMTSQIT=0 F S EXISTS=0 D SELTYP Q:GMTSQIT
  1. Q
  1. SELTYP ; Select Health Summary Type to Edit
  1. N CHANGE,DA,DIC,DIE,DLAYGO,DR,DUOUT,EXISTS,GMTSUM,GMTSNEW,GMTSMGR,GMTSEG,GMTSIFN,SELCNT,X,Y
  1. W ! S U="^",DIC="^GMT(142,",DIC(0)="AEMQL"
  1. S DIC("A")="Select Health Summary Type: "
  1. S DIC("S")="I +($$AHST^GMTSULT(+($G(Y))))" S DLAYGO=142
  1. S Y=$$TYPE^GMTSULT K DIC S:+Y'>0 GMTSQIT=1 Q:+Y'>0 S (GMTSIFN,DA)=+Y
  1. S GMTSUM=$P(Y,U,2),GMTSNEW=+$P(Y,U,3),GMTSMGR=$S($D(^XUSEC("GMTSMGR",DUZ)):1,1:0)
  1. I 'GMTSMGR,($P(^GMT(142,+DA,0),U,2)]"") D Q:'GMTSMGR
  1. . S GMTSMGR=$D(^XUSEC($P(^(0),U,2),DUZ))
  1. . W:'GMTSMGR !,$C(7),"This summary report is currently locked to prevent alteration.",!
  1. I 'GMTSMGR,'GMTSNEW,($P(^GMT(142,+DA,0),U,3)'=DUZ) W !,$C(7),"Alteration of this summary report is restricted to its owner.",!,"See the Clinical Coordinator if you need additional help." Q
  1. I $D(^GMT(142.5,"AC",+DA)) D Q:+DA'>0
  1. . W !!,$C(7),"WARNING: You are about to edit a Health Summary Type that is being used"
  1. . W !,"by a Health Summary Object. Changing the structure of this Health Summary"
  1. . W !,"Type will alter how the Object will display.",! H 1
  1. . N DIR,DTOUT,DUOUT,DIROUT,X,Y S DIR(0)="YAO",DIR("B")="NO"
  1. . S DIR("A")="Do want to continue? " D ^DIR S:+Y'>0 DA=0
  1. . I $D(DTOUT)!($D(DUOUT))!($D(DIROUT)) S DA=0,GMTSQIT=1
  1. S DIE="^GMT(142,",(GMTSIFN,DA)=+Y,DR="[GMTS EDIT HLTH SUM TYPE]" D ^DIE
  1. I '$D(^GMT(142,+GMTSIFN,0))!$D(Y)!$D(DUOUT)!$D(DIROUT)!$D(DTOUT) D Q
  1. . S GMTSQIT=1 D CHKDEL Q
  1. I 'GMTSNEW,($O(^GMT(142,+GMTSIFN,1,0))) S EXISTS=1 D LIST,EXISTS Q
  1. D SELCMP^GMTSRM5 Q:GMTSQIT D LIST:EXISTS,EXISTS D CHKDEL
  1. Q
  1. CHKDEL ; Check for Possible Deletion (New Type without Component)
  1. Q:+($G(GMTSIFN))'>0 Q:'$D(^GMT(142,+($G(GMTSIFN)),0)) D:GMTSMGR!(GMTSNEW)!($P(^GMT(142,+GMTSIFN,0),U,3)'=$G(DUZ)) ADEL^GMTSRM2(+($G(GMTSIFN)))
  1. Q
  1. ENADHOC ; Entry point for AD HOC edit
  1. N %,C,CHANGE,DA,DIC,DIE,DR,DUOUT,EXISTS,I,GMTSIFN,GMTSN,GMTSNCNT,GMTSNEW
  1. N GMTSIFN,GMTSUM,P,SELCNT
  1. N GMTSQIT,GMTSFUNC,X,Y
  1. W !!,">>> EDITING the GMTS HS ADHOC OPTION Health Summary Type"
  1. S (GMTSNEW,GMTSQIT)=0
  1. S DIC=142,DIC(0)="XZF",X="GMTS HS ADHOC OPTION"
  1. S Y=$$TYPE^GMTSULT I +Y'>0 D ^GMTSLOAD Q:$D(DIRUT)!$D(DIROUT) G ENADHOC
  1. S GMTSIFN=+Y,GMTSUM=$P(Y,U,2),EXISTS=1
  1. S DIE="^GMT(142,",DA=GMTSIFN,DR=".08T" D ^DIE
  1. Q:$D(Y)
  1. D LIST,EXISTS
  1. Q
  1. EXISTS ; Edit an existing health summary type
  1. N CNT,NXTCMP Q:$D(DUOUT) S NXTCMP=0,NXTCMP(0)=0
  1. F CNT=$$GETCNT(GMTSIFN):0 D NXTCMP^GMTSRM1,LIST:GMTSQIT Q:GMTSQIT!($D(DUOUT)) K GMTSQIT,GMTSNEW,TWEENER,SOACTION
  1. I NXTCMP>0 W !,"Please hold on while I resequence the summary order" D COPY^GMTSRN,RNMBR^GMTSRN:CHANGE
  1. Q
  1. LIST ; Lists existing summary parameters
  1. N B,DIC,DIR,IOP,Y,FR,TO,BY,DHD,FLDS,L
  1. I GMTSQIT'=2 Q:($D(DUOUT)!(GMTSQIT=1))
  1. I GMTSQIT=2,(NXTCMP=0) S GMTSQIT=0 Q
  1. I 'GMTSNEW W ! S DIC=142,DIR(0)="Y",DIR("A")="Do you wish to review the Summary Type structure before continuing",DIR("B")="NO" D ^DIR K DIR I 'Y S:GMTSQIT=2 DUOUT="" S:GMTSQIT=2 GMTSQIT="D" S:$D(DUOUT) GMTSQIT=1 Q
  1. I $D(GMTSQIT),GMTSQIT=2 S GMTSQIT=0
  1. S IOP="HOME",DIC=142,(FR,TO)=GMTSUM,BY=".01",DHD="[GMTS TYPE INQ HEADER]-[GMTS TYPE INQ FOOTER]",FLDS="[GMTS TYPE INQ]",L=0 D EN1^DIP
  1. Q
  1. GETCNT(GMTSIFN) ; Determine default summary order for new component
  1. N LI,LCNT S LI=0,LCNT=5 F S LI=$O(^GMT(142,+GMTSIFN,1,LI)) Q:+LI'>0 S LCNT=$P(LI,".")+5
  1. Q LCNT