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

GMTSRM1.m

Go to the documentation of this file.
  1. GMTSRM1 ;SLC/JER,DLT - Create/Modify Health Summary (cont'd) ; 07/18/2000
  1. ;;2.7;Health Summary;**7,36,37,62**;Oct 20, 1995
  1. ;
  1. ; External References
  1. ; DBIA 10006 ^DIC
  1. ; DBIA 10026 ^DIR
  1. ; DBIA 10018 ^DIE
  1. ;
  1. NXTCMP ; Edit, add, or delete components from existing structure
  1. N CMP,D,D0,DI,DIC,DIR,OLDSO,SEL,X,Y K DIRUT
  1. K DUOUT S GMTSQIT=0,GMTSNEW=0
  1. S DIC="^GMT(142.1,",DIC(0)="AEMQ",D="B",DIC("W")="W ?40,"" "",$P(^(0),U,4)",DIC("A")="Select COMPONENT: ",DIC("S")="I $P(^(0),U,6)'=""P""" S:$D(GMCMP) DIC("B")=$P(^GMT(142.1,+GMCMP,0),U)
  1. D ^DIC K DIC S:('$D(DTOUT)&('$D(DUOUT))&(Y=-1)) GMTSQIT=2 S:(Y=-1&(X'="^LOOP")) DUOUT=1
  1. I $D(DUOUT),(X="^LOOP") K DUOUT D LOOP K DUOUT Q
  1. I $D(DUOUT) Q
  1. D CHKCMP Q:$D(DUOUT)!(GMTSQIT)!(GMTSQIT="D")
  1. S DIR(0)="142.01,.01",DIR("B")=+$G(CNT)
  1. D ^DIR K DIR K:$D(DUOUT) DUOUT D:'$D(DIRUT) CHKSO^GMTSRM1A Q:$D(DIRUT)!(GMTSQIT)
  1. D ASKCMP I $D(GMCMP) S DUOUT=""
  1. Q
  1. LOOP ; Loop through STRUCTURE multiple and call ASKCMP for each
  1. N GMI,GMJ
  1. S GMI=0 F S GMI=$O(^GMT(142,GMTSIFN,1,GMI)) Q:GMI'>0!$D(DUOUT)!+GMTSQIT!(GMTSQIT="D") D
  1. . N CMP,DIR,X,Y
  1. . S CMP=$P(^GMT(142,GMTSIFN,1,GMI,0),U,2),CMP("NM")=$P($G(^GMT(142.1,+CMP,0)),U),CMP(1)=+CMP
  1. . S CMP(0)=$G(^GMT(142,+GMTSIFN,1,+GMI,0))
  1. . S CMP(.01)=GMI
  1. . S GMJ=0 F S GMJ=$O(^GMT(142,+GMTSIFN,1,+GMI,1,GMJ)) Q:+GMJ'>0 D
  1. . . S CMP(142.14,GMJ)=$G(^GMT(142,GMTSIFN,1,GMI,1,GMJ,0))
  1. . W !!?3,CMP("NM")
  1. . S (NXTCMP,NXTCMP(0))=NXTCMP+1 D ASKCMP I $D(Y),'$D(DTOUT) D
  1. . . S DIR(0)="Y",DIR("A")="WANT TO STOP LOOPING",DIR("B")="YES"
  1. . . D ^DIR K DIR W ! I +Y S GMTSQIT="D" W !!?4,"LOOP ENDED!",!!
  1. Q
  1. ASKCMP ; Ask parameters for each component
  1. N IEN,MAXOCC,TIME,OCC,HOSP,ICD,PROV,CPT,SELCNT,GMTSNCNT,GMTSN
  1. N OLDLIM,OLDOCC,OLDHEAD,OLDSO,OLDHOSP,OLDICD,OLDPROV,OLDCPT,SUMORD,CMPNAM
  1. S MAXOCC=$S($P($G(^GMT(142.1,CMP(1),0)),U,5)="Y":1,1:0)
  1. S TIME=$S($P($G(^GMT(142.1,CMP(1),0)),U,3)="Y":1,1:0)
  1. S HOSP=$S($P($G(^GMT(142.1,CMP(1),0)),U,10)="Y":1,1:0)
  1. S ICD=$S($P($G(^GMT(142.1,CMP(1),0)),U,11)="Y":1,1:0)
  1. S PROV=$S($P($G(^GMT(142.1,CMP(1),0)),U,12)="Y":1,1:0)
  1. S CPT=$S($P($G(^GMT(142.1,CMP(1),0)),U,14)="Y":1,1:0)
  1. S OLDOCC=$P($G(CMP(0)),U,3),OLDLIM=$P($G(CMP(0)),U,4)
  1. S OLDHOSP=$P($G(CMP(0)),U,6),OLDICD=$P($G(CMP(0)),U,7)
  1. S OLDPROV=$P($G(CMP(0)),U,8),OLDCPT=$P($G(CMP(0)),U,9)
  1. S OLDHEAD=$S($L($P($G(CMP(0)),U,5)):$P($G(CMP(0)),U,5),$L($P(^GMT(142.1,+CMP(1),0),U,9)):$P(^(0),U,9),1:"")
  1. S SEL=$O(^GMT(142.1,CMP(1),1,0))
  1. I SEL D
  1. . S SEL(0)=^GMT(142.1,CMP(1),1,SEL,0),SEL=$P(SEL(0),U),SELCNT=$P(SEL(0),U,2)
  1. . I SEL S DIC("V")="I +Y(0)=SEL",IEN=0,DIC(0)="AEMQ" F S IEN=$O(CMP(142.14,IEN)) Q:'IEN D LOADSEL^GMTSRM1A
  1. I EXISTS=0 S EXISTS=1
  1. I '$D(^GMT(142,GMTSIFN,1,0)) S ^(0)="^142.01IA^0^0",GMTSNEW=1
  1. S SUMORD=$G(CMP(.01)),CMPNAM=$G(CMP(1))
  1. ;
  1. ; New .01 Summary Order N .001-9999.999
  1. ; New/Existing 1 Component Name P 142.1
  1. ;
  1. I +($G(GMTSNEW)) D
  1. . S DR=".01///^S X=SUMORD;1///^S X=CMPNAM;2///^S X=OLDOCC;3///^S X=OLDLIM;6///^S X=OLDHOSP;7///^S X=OLDICD;8///^S X=OLDPROV;9///^S X=OLDCPT;"
  1. E S DR="1///^S X=CMPNAM;"
  1. ;
  1. ; First Edit 2 Occurrence Limit N 1-99999
  1. ; 3 Time Limit F 1-5
  1. ; 6 Hospital Loc Disp Y/N/""
  1. ; 7 ICD Text Displayed L/S/C/T/N
  1. ; 8 Provider Narr Disp Y/N/""
  1. ; 9 CPT Mod Displayed Y/N/""
  1. ;
  1. S:+($G(MAXOCC))>0 DR=DR_"2//"_OLDOCC_";" S:+($G(TIME))>0 DR=DR_"3//"_OLDLIM_";"
  1. S:+($G(HOSP))>0 DR=DR_"6//"_OLDHOSP_";" S:+($G(ICD))>0 DR=DR_"7//"_OLDICD_";"
  1. S:+($G(PROV))>0 DR=DR_"8//"_OLDPROV_";" S:+($G(CPT))>0 DR=DR_"9//"_OLDCPT_";"
  1. S DIE="^GMT(142,"_GMTSIFN_",1,",DA(1)=GMTSIFN,DA=CMP(.01)
  1. D ^DIE Q:$D(Y)
  1. ;
  1. ; Second Edit 4 Selection Item 142.14 Items
  1. ; 5 Header Name F 2-20
  1. ;
  1. S DR(2,142.14)=".01;D EXIT^GMTSRM3 I +SELCNT,(GMTSNCNT'<SELCNT) S DTOUT="""""
  1. S DR="5//^S X=$G(OLDHEAD);I 'SEL S Y=0;D EN^GMTSRM3;4"
  1. D ^DIE K DIC("V")
  1. S (GMTSNCNT,GMTSN)=0 F S GMTSN=$O(^GMT(142,DA(1),1,DA,1,GMTSN)) Q:'GMTSN S GMTSNCNT=GMTSNCNT+1
  1. I +GMTSNCNT>1 D REITEM^GMTSRM3(DA(1),DA)
  1. Q
  1. CHKCMP ; Checks selected component for duplication
  1. N DIR,SEL,SO,SOACTION
  1. K OLDSO
  1. S SOACTION="",CMP=+Y,CMP("NM")=$P(Y,U,2),(NXTCMP(0),NXTCMP)=NXTCMP+1
  1. I '$D(^GMT(142,GMTSIFN,1,"C",+CMP)) D Q
  1. . S CMP(1)=+CMP,CNT=$$GETCNT^GMTSRM(GMTSIFN)
  1. . I +CMP>300,$O(^GMT(142.1,+CMP(1),1,0)),'$D(CMP(142.14)) D GETSEL^GMTSRM1A(.CMP)
  1. S SO=$O(^GMT(142,GMTSIFN,1,"C",+CMP,0))
  1. W !,$P(Y,U,2)," is already a component of this summary."
  1. S DIR(0)="SO^E:Edit component parameters;D:Delete component from summary;"
  1. S DIR("A")="Select Action"
  1. D ^DIR K DIR
  1. I $D(DUOUT) S NXTCMP=NXTCMP-1 Q
  1. I $D(DIRUT)&('$D(DTOUT)) S GMTSQIT=$S('$D(GMCMP):"D",1:1) W ! Q
  1. I $D(DIRUT) S GMTSQIT=1 Q
  1. S OLDSO=SO I Y="D" S SOACTION="D" D DELCMP^GMTSRM4 W ! S GMTSQIT="D" Q
  1. S SOACTION="E",CMP(1)=+CMP,CNT=SO K Y
  1. S CMP(0)=^GMT(142,GMTSIFN,1,SO,0)
  1. S SEL=0 F S SEL=$O(^GMT(142,GMTSIFN,1,SO,1,SEL)) Q:+SEL'>0 S CMP(142.14,SEL)=^(SEL,0)
  1. I +CMP>100,$O(^GMT(142.1,+CMP(1),1,0)),'$D(CMP(142.14)) D
  1. . D GETSEL^GMTSRM1A(.CMP)
  1. Q