- GMTSRM1A ;SLC/JER,SBW - Create/Modify Health Summary (cont) ; 08/27/2002
- ;;2.7;Health Summary;**56**;Oct 20, 1995
- ;
- ; External References
- ; DBIA 10026 ^DIR
- ; DBIA 10018 ^DIE
- ;
- CHKSO ; Checks for existence of Summary Order (SO).
- ;
- ; Allows for overwrite or insertion prior
- ; to existing "structure" records
- ;
- N SO,SOACTION,DIR
- S SO=+Y,CMP(0)=$G(CMP(0))
- I $D(OLDSO),OLDSO=SO S CMP(.01)=SO Q
- I $D(OLDSO),OLDSO'=SO S SOACTION="E" D DELCMP^GMTSRM4
- I '$D(^GMT(142,GMTSIFN,1,SO,0)) S CMP(.01)=+SO,GMTSNEW=1 Q
- W !,$P(^GMT(142.1,$P(^GMT(142,GMTSIFN,1,SO,0),U,2),0),U)," Already exists at SUMMARY ORDER ",SO
- S DIR(0)="SO^O:Overwrite;I:Insert Before;A:Append After",DIR("A")="Select Action" D ^DIR K DIR I $D(DIRUT) S GMTSQIT=1 Q
- I Y="O" S SOACTION="O",OLDSO=SO D DELCMP^GMTSRM4 S GMTSNEW=1,CMP(.01)=SO Q
- I Y="I" D INSRT^GMTSRM4 Q
- I Y="A" D APPND^GMTSRM4
- Q
- LOADSEL ; Load Selection Item Multiple
- N DA,DC,DIC,DIE,DIEL,DK,DL,DM,DP,DR
- S:'$D(^GMT(142,GMTSIFN,1,CMP(.01),1,0)) ^(0)="^142.14V^^"
- S (DIC,DIE)="^GMT(142,"_GMTSIFN_",1,"_CMP(.01)_",1,",DA(2)=GMTSIFN,DA(1)=CMP(.01),DA=IEN S DR=".01////"_"^S X=CMP(142.14,IEN)" D ^DIE
- Q
- ;
- GETSEL(CMP) ; Get Default Selection Items
- ;
- ; Taken from Ad Hoc for Local Components
- N GMI,GMJ,GMK
- S GMI=$O(^GMT(142,"B","GMTS HS ADHOC OPTION",0)) Q:+GMI'>0
- S GMJ=$O(^GMT(142,+GMI,1,"C",+CMP,0)) Q:+GMJ'>0
- S GMK=0 F S GMK=$O(^GMT(142,+GMI,1,+GMJ,1,GMK)) Q:+GMK'>0 D
- . S CMP(142.14,GMK)=$G(^GMT(142,+GMI,1,+GMJ,1,+GMK,0))
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSRM1A 1626 printed Feb 18, 2025@23:26:29 Page 2
- GMTSRM1A ;SLC/JER,SBW - Create/Modify Health Summary (cont) ; 08/27/2002
- +1 ;;2.7;Health Summary;**56**;Oct 20, 1995
- +2 ;
- +3 ; External References
- +4 ; DBIA 10026 ^DIR
- +5 ; DBIA 10018 ^DIE
- +6 ;
- CHKSO ; Checks for existence of Summary Order (SO).
- +1 ;
- +2 ; Allows for overwrite or insertion prior
- +3 ; to existing "structure" records
- +4 ;
- +5 NEW SO,SOACTION,DIR
- +6 SET SO=+Y
- SET CMP(0)=$GET(CMP(0))
- +7 IF $DATA(OLDSO)
- IF OLDSO=SO
- SET CMP(.01)=SO
- QUIT
- +8 IF $DATA(OLDSO)
- IF OLDSO'=SO
- SET SOACTION="E"
- DO DELCMP^GMTSRM4
- +9 IF '$DATA(^GMT(142,GMTSIFN,1,SO,0))
- SET CMP(.01)=+SO
- SET GMTSNEW=1
- QUIT
- +10 WRITE !,$PIECE(^GMT(142.1,$PIECE(^GMT(142,GMTSIFN,1,SO,0),U,2),0),U)," Already exists at SUMMARY ORDER ",SO
- +11 SET DIR(0)="SO^O:Overwrite;I:Insert Before;A:Append After"
- SET DIR("A")="Select Action"
- DO ^DIR
- KILL DIR
- IF $DATA(DIRUT)
- SET GMTSQIT=1
- QUIT
- +12 IF Y="O"
- SET SOACTION="O"
- SET OLDSO=SO
- DO DELCMP^GMTSRM4
- SET GMTSNEW=1
- SET CMP(.01)=SO
- QUIT
- +13 IF Y="I"
- DO INSRT^GMTSRM4
- QUIT
- +14 IF Y="A"
- DO APPND^GMTSRM4
- +15 QUIT
- LOADSEL ; Load Selection Item Multiple
- +1 NEW DA,DC,DIC,DIE,DIEL,DK,DL,DM,DP,DR
- +2 if '$DATA(^GMT(142,GMTSIFN,1,CMP(.01),1,0))
- SET ^(0)="^142.14V^^"
- +3 SET (DIC,DIE)="^GMT(142,"_GMTSIFN_",1,"_CMP(.01)_",1,"
- SET DA(2)=GMTSIFN
- SET DA(1)=CMP(.01)
- SET DA=IEN
- SET DR=".01////"_"^S X=CMP(142.14,IEN)"
- DO ^DIE
- +4 QUIT
- +5 ;
- GETSEL(CMP) ; Get Default Selection Items
- +1 ;
- +2 ; Taken from Ad Hoc for Local Components
- +3 NEW GMI,GMJ,GMK
- +4 SET GMI=$ORDER(^GMT(142,"B","GMTS HS ADHOC OPTION",0))
- if +GMI'>0
- QUIT
- +5 SET GMJ=$ORDER(^GMT(142,+GMI,1,"C",+CMP,0))
- if +GMJ'>0
- QUIT
- +6 SET GMK=0
- FOR
- SET GMK=$ORDER(^GMT(142,+GMI,1,+GMJ,1,GMK))
- if +GMK'>0
- QUIT
- Begin DoDot:1
- +7 SET CMP(142.14,GMK)=$GET(^GMT(142,+GMI,1,+GMJ,1,+GMK,0))
- End DoDot:1
- +8 QUIT
