- GMTSRM1 ;SLC/JER,DLT - Create/Modify Health Summary (cont'd) ; 07/18/2000
- ;;2.7;Health Summary;**7,36,37,62**;Oct 20, 1995
- ;
- ; External References
- ; DBIA 10006 ^DIC
- ; DBIA 10026 ^DIR
- ; DBIA 10018 ^DIE
- ;
- NXTCMP ; Edit, add, or delete components from existing structure
- N CMP,D,D0,DI,DIC,DIR,OLDSO,SEL,X,Y K DIRUT
- K DUOUT S GMTSQIT=0,GMTSNEW=0
- 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)
- D ^DIC K DIC S:('$D(DTOUT)&('$D(DUOUT))&(Y=-1)) GMTSQIT=2 S:(Y=-1&(X'="^LOOP")) DUOUT=1
- I $D(DUOUT),(X="^LOOP") K DUOUT D LOOP K DUOUT Q
- I $D(DUOUT) Q
- D CHKCMP Q:$D(DUOUT)!(GMTSQIT)!(GMTSQIT="D")
- S DIR(0)="142.01,.01",DIR("B")=+$G(CNT)
- D ^DIR K DIR K:$D(DUOUT) DUOUT D:'$D(DIRUT) CHKSO^GMTSRM1A Q:$D(DIRUT)!(GMTSQIT)
- D ASKCMP I $D(GMCMP) S DUOUT=""
- Q
- LOOP ; Loop through STRUCTURE multiple and call ASKCMP for each
- N GMI,GMJ
- S GMI=0 F S GMI=$O(^GMT(142,GMTSIFN,1,GMI)) Q:GMI'>0!$D(DUOUT)!+GMTSQIT!(GMTSQIT="D") D
- . N CMP,DIR,X,Y
- . S CMP=$P(^GMT(142,GMTSIFN,1,GMI,0),U,2),CMP("NM")=$P($G(^GMT(142.1,+CMP,0)),U),CMP(1)=+CMP
- . S CMP(0)=$G(^GMT(142,+GMTSIFN,1,+GMI,0))
- . S CMP(.01)=GMI
- . S GMJ=0 F S GMJ=$O(^GMT(142,+GMTSIFN,1,+GMI,1,GMJ)) Q:+GMJ'>0 D
- . . S CMP(142.14,GMJ)=$G(^GMT(142,GMTSIFN,1,GMI,1,GMJ,0))
- . W !!?3,CMP("NM")
- . S (NXTCMP,NXTCMP(0))=NXTCMP+1 D ASKCMP I $D(Y),'$D(DTOUT) D
- . . S DIR(0)="Y",DIR("A")="WANT TO STOP LOOPING",DIR("B")="YES"
- . . D ^DIR K DIR W ! I +Y S GMTSQIT="D" W !!?4,"LOOP ENDED!",!!
- Q
- ASKCMP ; Ask parameters for each component
- N IEN,MAXOCC,TIME,OCC,HOSP,ICD,PROV,CPT,SELCNT,GMTSNCNT,GMTSN
- N OLDLIM,OLDOCC,OLDHEAD,OLDSO,OLDHOSP,OLDICD,OLDPROV,OLDCPT,SUMORD,CMPNAM
- S MAXOCC=$S($P($G(^GMT(142.1,CMP(1),0)),U,5)="Y":1,1:0)
- S TIME=$S($P($G(^GMT(142.1,CMP(1),0)),U,3)="Y":1,1:0)
- S HOSP=$S($P($G(^GMT(142.1,CMP(1),0)),U,10)="Y":1,1:0)
- S ICD=$S($P($G(^GMT(142.1,CMP(1),0)),U,11)="Y":1,1:0)
- S PROV=$S($P($G(^GMT(142.1,CMP(1),0)),U,12)="Y":1,1:0)
- S CPT=$S($P($G(^GMT(142.1,CMP(1),0)),U,14)="Y":1,1:0)
- S OLDOCC=$P($G(CMP(0)),U,3),OLDLIM=$P($G(CMP(0)),U,4)
- S OLDHOSP=$P($G(CMP(0)),U,6),OLDICD=$P($G(CMP(0)),U,7)
- S OLDPROV=$P($G(CMP(0)),U,8),OLDCPT=$P($G(CMP(0)),U,9)
- 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:"")
- S SEL=$O(^GMT(142.1,CMP(1),1,0))
- I SEL D
- . S SEL(0)=^GMT(142.1,CMP(1),1,SEL,0),SEL=$P(SEL(0),U),SELCNT=$P(SEL(0),U,2)
- . 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
- I EXISTS=0 S EXISTS=1
- I '$D(^GMT(142,GMTSIFN,1,0)) S ^(0)="^142.01IA^0^0",GMTSNEW=1
- S SUMORD=$G(CMP(.01)),CMPNAM=$G(CMP(1))
- ;
- ; New .01 Summary Order N .001-9999.999
- ; New/Existing 1 Component Name P 142.1
- ;
- I +($G(GMTSNEW)) D
- . 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;"
- E S DR="1///^S X=CMPNAM;"
- ;
- ; First Edit 2 Occurrence Limit N 1-99999
- ; 3 Time Limit F 1-5
- ; 6 Hospital Loc Disp Y/N/""
- ; 7 ICD Text Displayed L/S/C/T/N
- ; 8 Provider Narr Disp Y/N/""
- ; 9 CPT Mod Displayed Y/N/""
- ;
- S:+($G(MAXOCC))>0 DR=DR_"2//"_OLDOCC_";" S:+($G(TIME))>0 DR=DR_"3//"_OLDLIM_";"
- S:+($G(HOSP))>0 DR=DR_"6//"_OLDHOSP_";" S:+($G(ICD))>0 DR=DR_"7//"_OLDICD_";"
- S:+($G(PROV))>0 DR=DR_"8//"_OLDPROV_";" S:+($G(CPT))>0 DR=DR_"9//"_OLDCPT_";"
- S DIE="^GMT(142,"_GMTSIFN_",1,",DA(1)=GMTSIFN,DA=CMP(.01)
- D ^DIE Q:$D(Y)
- ;
- ; Second Edit 4 Selection Item 142.14 Items
- ; 5 Header Name F 2-20
- ;
- S DR(2,142.14)=".01;D EXIT^GMTSRM3 I +SELCNT,(GMTSNCNT'<SELCNT) S DTOUT="""""
- S DR="5//^S X=$G(OLDHEAD);I 'SEL S Y=0;D EN^GMTSRM3;4"
- D ^DIE K DIC("V")
- S (GMTSNCNT,GMTSN)=0 F S GMTSN=$O(^GMT(142,DA(1),1,DA,1,GMTSN)) Q:'GMTSN S GMTSNCNT=GMTSNCNT+1
- I +GMTSNCNT>1 D REITEM^GMTSRM3(DA(1),DA)
- Q
- CHKCMP ; Checks selected component for duplication
- N DIR,SEL,SO,SOACTION
- K OLDSO
- S SOACTION="",CMP=+Y,CMP("NM")=$P(Y,U,2),(NXTCMP(0),NXTCMP)=NXTCMP+1
- I '$D(^GMT(142,GMTSIFN,1,"C",+CMP)) D Q
- . S CMP(1)=+CMP,CNT=$$GETCNT^GMTSRM(GMTSIFN)
- . I +CMP>300,$O(^GMT(142.1,+CMP(1),1,0)),'$D(CMP(142.14)) D GETSEL^GMTSRM1A(.CMP)
- S SO=$O(^GMT(142,GMTSIFN,1,"C",+CMP,0))
- W !,$P(Y,U,2)," is already a component of this summary."
- S DIR(0)="SO^E:Edit component parameters;D:Delete component from summary;"
- S DIR("A")="Select Action"
- D ^DIR K DIR
- I $D(DUOUT) S NXTCMP=NXTCMP-1 Q
- I $D(DIRUT)&('$D(DTOUT)) S GMTSQIT=$S('$D(GMCMP):"D",1:1) W ! Q
- I $D(DIRUT) S GMTSQIT=1 Q
- S OLDSO=SO I Y="D" S SOACTION="D" D DELCMP^GMTSRM4 W ! S GMTSQIT="D" Q
- S SOACTION="E",CMP(1)=+CMP,CNT=SO K Y
- S CMP(0)=^GMT(142,GMTSIFN,1,SO,0)
- S SEL=0 F S SEL=$O(^GMT(142,GMTSIFN,1,SO,1,SEL)) Q:+SEL'>0 S CMP(142.14,SEL)=^(SEL,0)
- I +CMP>100,$O(^GMT(142.1,+CMP(1),1,0)),'$D(CMP(142.14)) D
- . D GETSEL^GMTSRM1A(.CMP)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSRM1 5198 printed Jan 18, 2025@03:01:18 Page 2
- 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
- +2 ;
- +3 ; External References
- +4 ; DBIA 10006 ^DIC
- +5 ; DBIA 10026 ^DIR
- +6 ; DBIA 10018 ^DIE
- +7 ;
- NXTCMP ; Edit, add, or delete components from existing structure
- +1 NEW CMP,D,D0,DI,DIC,DIR,OLDSO,SEL,X,Y
- KILL DIRUT
- +2 KILL DUOUT
- SET GMTSQIT=0
- SET GMTSNEW=0
- +3 SET DIC="^GMT(142.1,"
- SET DIC(0)="AEMQ"
- SET D="B"
- SET DIC("W")="W ?40,"" "",$P(^(0),U,4)"
- SET DIC("A")="Select COMPONENT: "
- SET DIC("S")="I $P(^(0),U,6)'=""P"""
- if $DATA(GMCMP)
- SET DIC("B")=$PIECE(^GMT(142.1,+GMCMP,0),U)
- +4 DO ^DIC
- KILL DIC
- if ('$DATA(DTOUT)&('$DATA(DUOUT))&(Y=-1))
- SET GMTSQIT=2
- if (Y=-1&(X'="^LOOP"))
- SET DUOUT=1
- +5 IF $DATA(DUOUT)
- IF (X="^LOOP")
- KILL DUOUT
- DO LOOP
- KILL DUOUT
- QUIT
- +6 IF $DATA(DUOUT)
- QUIT
- +7 DO CHKCMP
- if $DATA(DUOUT)!(GMTSQIT)!(GMTSQIT="D")
- QUIT
- +8 SET DIR(0)="142.01,.01"
- SET DIR("B")=+$GET(CNT)
- +9 DO ^DIR
- KILL DIR
- if $DATA(DUOUT)
- KILL DUOUT
- if '$DATA(DIRUT)
- DO CHKSO^GMTSRM1A
- if $DATA(DIRUT)!(GMTSQIT)
- QUIT
- +10 DO ASKCMP
- IF $DATA(GMCMP)
- SET DUOUT=""
- +11 QUIT
- LOOP ; Loop through STRUCTURE multiple and call ASKCMP for each
- +1 NEW GMI,GMJ
- +2 SET GMI=0
- FOR
- SET GMI=$ORDER(^GMT(142,GMTSIFN,1,GMI))
- if GMI'>0!$DATA(DUOUT)!+GMTSQIT!(GMTSQIT="D")
- QUIT
- Begin DoDot:1
- +3 NEW CMP,DIR,X,Y
- +4 SET CMP=$PIECE(^GMT(142,GMTSIFN,1,GMI,0),U,2)
- SET CMP("NM")=$PIECE($GET(^GMT(142.1,+CMP,0)),U)
- SET CMP(1)=+CMP
- +5 SET CMP(0)=$GET(^GMT(142,+GMTSIFN,1,+GMI,0))
- +6 SET CMP(.01)=GMI
- +7 SET GMJ=0
- FOR
- SET GMJ=$ORDER(^GMT(142,+GMTSIFN,1,+GMI,1,GMJ))
- if +GMJ'>0
- QUIT
- Begin DoDot:2
- +8 SET CMP(142.14,GMJ)=$GET(^GMT(142,GMTSIFN,1,GMI,1,GMJ,0))
- End DoDot:2
- +9 WRITE !!?3,CMP("NM")
- +10 SET (NXTCMP,NXTCMP(0))=NXTCMP+1
- DO ASKCMP
- IF $DATA(Y)
- IF '$DATA(DTOUT)
- Begin DoDot:2
- +11 SET DIR(0)="Y"
- SET DIR("A")="WANT TO STOP LOOPING"
- SET DIR("B")="YES"
- +12 DO ^DIR
- KILL DIR
- WRITE !
- IF +Y
- SET GMTSQIT="D"
- WRITE !!?4,"LOOP ENDED!",!!
- End DoDot:2
- End DoDot:1
- +13 QUIT
- ASKCMP ; Ask parameters for each component
- +1 NEW IEN,MAXOCC,TIME,OCC,HOSP,ICD,PROV,CPT,SELCNT,GMTSNCNT,GMTSN
- +2 NEW OLDLIM,OLDOCC,OLDHEAD,OLDSO,OLDHOSP,OLDICD,OLDPROV,OLDCPT,SUMORD,CMPNAM
- +3 SET MAXOCC=$SELECT($PIECE($GET(^GMT(142.1,CMP(1),0)),U,5)="Y":1,1:0)
- +4 SET TIME=$SELECT($PIECE($GET(^GMT(142.1,CMP(1),0)),U,3)="Y":1,1:0)
- +5 SET HOSP=$SELECT($PIECE($GET(^GMT(142.1,CMP(1),0)),U,10)="Y":1,1:0)
- +6 SET ICD=$SELECT($PIECE($GET(^GMT(142.1,CMP(1),0)),U,11)="Y":1,1:0)
- +7 SET PROV=$SELECT($PIECE($GET(^GMT(142.1,CMP(1),0)),U,12)="Y":1,1:0)
- +8 SET CPT=$SELECT($PIECE($GET(^GMT(142.1,CMP(1),0)),U,14)="Y":1,1:0)
- +9 SET OLDOCC=$PIECE($GET(CMP(0)),U,3)
- SET OLDLIM=$PIECE($GET(CMP(0)),U,4)
- +10 SET OLDHOSP=$PIECE($GET(CMP(0)),U,6)
- SET OLDICD=$PIECE($GET(CMP(0)),U,7)
- +11 SET OLDPROV=$PIECE($GET(CMP(0)),U,8)
- SET OLDCPT=$PIECE($GET(CMP(0)),U,9)
- +12 SET OLDHEAD=$SELECT($LENGTH($PIECE($GET(CMP(0)),U,5)):$PIECE($GET(CMP(0)),U,5),$LENGTH($PIECE(^GMT(142.1,+CMP(1),0),U,9)):$PIECE(^(0),U,9),1:"")
- +13 SET SEL=$ORDER(^GMT(142.1,CMP(1),1,0))
- +14 IF SEL
- Begin DoDot:1
- +15 SET SEL(0)=^GMT(142.1,CMP(1),1,SEL,0)
- SET SEL=$PIECE(SEL(0),U)
- SET SELCNT=$PIECE(SEL(0),U,2)
- +16 IF SEL
- SET DIC("V")="I +Y(0)=SEL"
- SET IEN=0
- SET DIC(0)="AEMQ"
- FOR
- SET IEN=$ORDER(CMP(142.14,IEN))
- if 'IEN
- QUIT
- DO LOADSEL^GMTSRM1A
- End DoDot:1
- +17 IF EXISTS=0
- SET EXISTS=1
- +18 IF '$DATA(^GMT(142,GMTSIFN,1,0))
- SET ^(0)="^142.01IA^0^0"
- SET GMTSNEW=1
- +19 SET SUMORD=$GET(CMP(.01))
- SET CMPNAM=$GET(CMP(1))
- +20 ;
- +21 ; New .01 Summary Order N .001-9999.999
- +22 ; New/Existing 1 Component Name P 142.1
- +23 ;
- +24 IF +($GET(GMTSNEW))
- Begin DoDot:1
- +25 SET 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;"
- End DoDot:1
- +26 IF '$TEST
- SET DR="1///^S X=CMPNAM;"
- +27 ;
- +28 ; First Edit 2 Occurrence Limit N 1-99999
- +29 ; 3 Time Limit F 1-5
- +30 ; 6 Hospital Loc Disp Y/N/""
- +31 ; 7 ICD Text Displayed L/S/C/T/N
- +32 ; 8 Provider Narr Disp Y/N/""
- +33 ; 9 CPT Mod Displayed Y/N/""
- +34 ;
- +35 if +($GET(MAXOCC))>0
- SET DR=DR_"2//"_OLDOCC_";"
- if +($GET(TIME))>0
- SET DR=DR_"3//"_OLDLIM_";"
- +36 if +($GET(HOSP))>0
- SET DR=DR_"6//"_OLDHOSP_";"
- if +($GET(ICD))>0
- SET DR=DR_"7//"_OLDICD_";"
- +37 if +($GET(PROV))>0
- SET DR=DR_"8//"_OLDPROV_";"
- if +($GET(CPT))>0
- SET DR=DR_"9//"_OLDCPT_";"
- +38 SET DIE="^GMT(142,"_GMTSIFN_",1,"
- SET DA(1)=GMTSIFN
- SET DA=CMP(.01)
- +39 DO ^DIE
- if $DATA(Y)
- QUIT
- +40 ;
- +41 ; Second Edit 4 Selection Item 142.14 Items
- +42 ; 5 Header Name F 2-20
- +43 ;
- +44 SET DR(2,142.14)=".01;D EXIT^GMTSRM3 I +SELCNT,(GMTSNCNT'<SELCNT) S DTOUT="""""
- +45 SET DR="5//^S X=$G(OLDHEAD);I 'SEL S Y=0;D EN^GMTSRM3;4"
- +46 DO ^DIE
- KILL DIC("V")
- +47 SET (GMTSNCNT,GMTSN)=0
- FOR
- SET GMTSN=$ORDER(^GMT(142,DA(1),1,DA,1,GMTSN))
- if 'GMTSN
- QUIT
- SET GMTSNCNT=GMTSNCNT+1
- +48 IF +GMTSNCNT>1
- DO REITEM^GMTSRM3(DA(1),DA)
- +49 QUIT
- CHKCMP ; Checks selected component for duplication
- +1 NEW DIR,SEL,SO,SOACTION
- +2 KILL OLDSO
- +3 SET SOACTION=""
- SET CMP=+Y
- SET CMP("NM")=$PIECE(Y,U,2)
- SET (NXTCMP(0),NXTCMP)=NXTCMP+1
- +4 IF '$DATA(^GMT(142,GMTSIFN,1,"C",+CMP))
- Begin DoDot:1
- +5 SET CMP(1)=+CMP
- SET CNT=$$GETCNT^GMTSRM(GMTSIFN)
- +6 IF +CMP>300
- IF $ORDER(^GMT(142.1,+CMP(1),1,0))
- IF '$DATA(CMP(142.14))
- DO GETSEL^GMTSRM1A(.CMP)
- End DoDot:1
- QUIT
- +7 SET SO=$ORDER(^GMT(142,GMTSIFN,1,"C",+CMP,0))
- +8 WRITE !,$PIECE(Y,U,2)," is already a component of this summary."
- +9 SET DIR(0)="SO^E:Edit component parameters;D:Delete component from summary;"
- +10 SET DIR("A")="Select Action"
- +11 DO ^DIR
- KILL DIR
- +12 IF $DATA(DUOUT)
- SET NXTCMP=NXTCMP-1
- QUIT
- +13 IF $DATA(DIRUT)&('$DATA(DTOUT))
- SET GMTSQIT=$SELECT('$DATA(GMCMP):"D",1:1)
- WRITE !
- QUIT
- +14 IF $DATA(DIRUT)
- SET GMTSQIT=1
- QUIT
- +15 SET OLDSO=SO
- IF Y="D"
- SET SOACTION="D"
- DO DELCMP^GMTSRM4
- WRITE !
- SET GMTSQIT="D"
- QUIT
- +16 SET SOACTION="E"
- SET CMP(1)=+CMP
- SET CNT=SO
- KILL Y
- +17 SET CMP(0)=^GMT(142,GMTSIFN,1,SO,0)
- +18 SET SEL=0
- FOR
- SET SEL=$ORDER(^GMT(142,GMTSIFN,1,SO,1,SEL))
- if +SEL'>0
- QUIT
- SET CMP(142.14,SEL)=^(SEL,0)
- +19 IF +CMP>100
- IF $ORDER(^GMT(142.1,+CMP(1),1,0))
- IF '$DATA(CMP(142.14))
- Begin DoDot:1
- +20 DO GETSEL^GMTSRM1A(.CMP)
- End DoDot:1
- +21 QUIT