- GMTSRM5 ;SLC/DLT - Create/Modify - Copy from existing type ; 07/18/2000
- ;;2.7;Health Summary;**30,37**;Oct 20, 1995
- ;
- SELCMP ;Select components from existing health summary type
- N DIC,DIR,GMI,GMTSEG,GMTSEGI,GMTSTITL,GMTSTYP,I,SEQ,X,XQORM,Y
- W ! S DIR(0)="Y",DIR("A")="Do you wish to copy COMPONENTS from an existing Health Summary Type",DIR("B")="YES"
- ; DBIA 10026 call ^DIR
- D ^DIR S:+Y'>0 EXISTS=0 S:$D(DTOUT)!($D(DIROUT)) GMTSQIT=1 K DIR Q:+Y'>0
- W ! S GMTSQIT=0,DIC=142,DIC(0)="AEFQMZ",DIC("A")="Select Health Summary Type to copy from: "
- S Y=$$TYPE^GMTSULT K DIC S:Y=-1 GMTSQIT=1 Q:GMTSQIT S GMTSTYP=+Y,GMTSTITL=$P(Y,U,2)
- W @IOF,"The Following Components are Available:",!
- S XQORM("S")="I $P(^GMT(142.1,$P(^GMT(142,DA(1),1,DA,0),U,2),0),U,6)'=""Y"""
- S XQORM=GMTSTYP_";GMT(142,",XQORM(0)="DA",XQORM("A")="Select COMPONENTS(S): ",XQORM("??")="D HELP^GMTSRM2"
- ; DBIA 10140 call EN^XQORM
- D EN^XQORM I Y'>0 S GMTSQIT=1 K XQORM,Y Q
- S (X,GMI,SEQ)=0 F S GMI=$O(Y(GMI)) Q:'GMI S X=^GMT(142,GMTSTYP,1,+Y(GMI),0) I $P(X,U,2) S SEQ=SEQ+1,GMTSEG(SEQ)=X,GMTSEGI($P(X,U,2))=SEQ D SETUPSEL
- ;Load global from GMTSEG() array.
- S:'$D(^GMT(142,GMTSIFN,1,0)) ^(0)="^142.01IA^0^0"
- W !!,"Loading components into the Health Summary Type with defaults"
- S EXISTS=1
- S SEQ=0 F S SEQ=$O(GMTSEG(SEQ)) Q:'SEQ D LOADCMP
- Q
- LOADCMP ; Call DIE to stuff STRUCTURE multiple for each component
- N ISEQ,DA,DIE,DR,CNT,SDA,S2
- S (ISEQ,DA)=SEQ*5,DIE="^GMT(142,"_GMTSIFN_",1,",DA(1)=GMTSIFN
- S DR=".01///"_DA_";1///"_$P(GMTSEG(SEQ),U,2)_";2///"_$P(GMTSEG(SEQ),U,3)
- S DR=DR_";3///"_$P(GMTSEG(SEQ),U,4)_";5///"_$P(GMTSEG(SEQ),U,5)
- S DR=DR_";6///"_$P(GMTSEG(SEQ),U,6)_";7///"_$P(GMTSEG(SEQ),U,7)
- S DR=DR_";8///"_$P(GMTSEG(SEQ),U,8)_";9///"_$P(GMTSEG(SEQ),U,9)
- ; DBIA 10018 call ^DIE
- D ^DIE
- S (CNT,S2)=0 F S S2=$O(GMTSEG(SEQ,S2)) Q:'S2 D LOADSEL
- I CNT>0 S:'$D(^GMT(142,GMTSIFN,1,ISEQ,1,0)) ^(0)="^142.14V^"_SDA_"^"_CNT
- Q
- LOADSEL ; Loads selection item multiple
- N DIE,DA,DR
- S:'$D(^GMT(142,GMTSIFN,1,ISEQ,1,0)) ^(0)="^142.14V^^"
- S DIE="^GMT(142,"_GMTSIFN_",1,"_ISEQ_",1,",DA(2)=GMTSIFN,DA(1)=ISEQ,DA=S2,DR=".01////"_"^S X=GMTSEG(SEQ,S2)"
- ; DBIA 10018 call ^DIE
- D ^DIE S SDA=DA,CNT=CNT+1
- Q
- SETUPSEL ;Setup default selection items into new summary type
- N S2,SEL
- S S2=0 F S S2=$O(^GMT(142,GMTSTYP,1,+Y(GMI),1,S2)) Q:'S2 S SEL=^(S2,0) S GMTSEG(SEQ,S2)=SEL
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSRM5 2397 printed Feb 18, 2025@23:26:33 Page 2
- GMTSRM5 ;SLC/DLT - Create/Modify - Copy from existing type ; 07/18/2000
- +1 ;;2.7;Health Summary;**30,37**;Oct 20, 1995
- +2 ;
- SELCMP ;Select components from existing health summary type
- +1 NEW DIC,DIR,GMI,GMTSEG,GMTSEGI,GMTSTITL,GMTSTYP,I,SEQ,X,XQORM,Y
- +2 WRITE !
- SET DIR(0)="Y"
- SET DIR("A")="Do you wish to copy COMPONENTS from an existing Health Summary Type"
- SET DIR("B")="YES"
- +3 ; DBIA 10026 call ^DIR
- +4 DO ^DIR
- if +Y'>0
- SET EXISTS=0
- if $DATA(DTOUT)!($DATA(DIROUT))
- SET GMTSQIT=1
- KILL DIR
- if +Y'>0
- QUIT
- +5 WRITE !
- SET GMTSQIT=0
- SET DIC=142
- SET DIC(0)="AEFQMZ"
- SET DIC("A")="Select Health Summary Type to copy from: "
- +6 SET Y=$$TYPE^GMTSULT
- KILL DIC
- if Y=-1
- SET GMTSQIT=1
- if GMTSQIT
- QUIT
- SET GMTSTYP=+Y
- SET GMTSTITL=$PIECE(Y,U,2)
- +7 WRITE @IOF,"The Following Components are Available:",!
- +8 SET XQORM("S")="I $P(^GMT(142.1,$P(^GMT(142,DA(1),1,DA,0),U,2),0),U,6)'=""Y"""
- +9 SET XQORM=GMTSTYP_";GMT(142,"
- SET XQORM(0)="DA"
- SET XQORM("A")="Select COMPONENTS(S): "
- SET XQORM("??")="D HELP^GMTSRM2"
- +10 ; DBIA 10140 call EN^XQORM
- +11 DO EN^XQORM
- IF Y'>0
- SET GMTSQIT=1
- KILL XQORM,Y
- QUIT
- +12 SET (X,GMI,SEQ)=0
- FOR
- SET GMI=$ORDER(Y(GMI))
- if 'GMI
- QUIT
- SET X=^GMT(142,GMTSTYP,1,+Y(GMI),0)
- IF $PIECE(X,U,2)
- SET SEQ=SEQ+1
- SET GMTSEG(SEQ)=X
- SET GMTSEGI($PIECE(X,U,2))=SEQ
- DO SETUPSEL
- +13 ;Load global from GMTSEG() array.
- +14 if '$DATA(^GMT(142,GMTSIFN,1,0))
- SET ^(0)="^142.01IA^0^0"
- +15 WRITE !!,"Loading components into the Health Summary Type with defaults"
- +16 SET EXISTS=1
- +17 SET SEQ=0
- FOR
- SET SEQ=$ORDER(GMTSEG(SEQ))
- if 'SEQ
- QUIT
- DO LOADCMP
- +18 QUIT
- LOADCMP ; Call DIE to stuff STRUCTURE multiple for each component
- +1 NEW ISEQ,DA,DIE,DR,CNT,SDA,S2
- +2 SET (ISEQ,DA)=SEQ*5
- SET DIE="^GMT(142,"_GMTSIFN_",1,"
- SET DA(1)=GMTSIFN
- +3 SET DR=".01///"_DA_";1///"_$PIECE(GMTSEG(SEQ),U,2)_";2///"_$PIECE(GMTSEG(SEQ),U,3)
- +4 SET DR=DR_";3///"_$PIECE(GMTSEG(SEQ),U,4)_";5///"_$PIECE(GMTSEG(SEQ),U,5)
- +5 SET DR=DR_";6///"_$PIECE(GMTSEG(SEQ),U,6)_";7///"_$PIECE(GMTSEG(SEQ),U,7)
- +6 SET DR=DR_";8///"_$PIECE(GMTSEG(SEQ),U,8)_";9///"_$PIECE(GMTSEG(SEQ),U,9)
- +7 ; DBIA 10018 call ^DIE
- +8 DO ^DIE
- +9 SET (CNT,S2)=0
- FOR
- SET S2=$ORDER(GMTSEG(SEQ,S2))
- if 'S2
- QUIT
- DO LOADSEL
- +10 IF CNT>0
- if '$DATA(^GMT(142,GMTSIFN,1,ISEQ,1,0))
- SET ^(0)="^142.14V^"_SDA_"^"_CNT
- +11 QUIT
- LOADSEL ; Loads selection item multiple
- +1 NEW DIE,DA,DR
- +2 if '$DATA(^GMT(142,GMTSIFN,1,ISEQ,1,0))
- SET ^(0)="^142.14V^^"
- +3 SET DIE="^GMT(142,"_GMTSIFN_",1,"_ISEQ_",1,"
- SET DA(2)=GMTSIFN
- SET DA(1)=ISEQ
- SET DA=S2
- SET DR=".01////"_"^S X=GMTSEG(SEQ,S2)"
- +4 ; DBIA 10018 call ^DIE
- +5 DO ^DIE
- SET SDA=DA
- SET CNT=CNT+1
- +6 QUIT
- SETUPSEL ;Setup default selection items into new summary type
- +1 NEW S2,SEL
- +2 SET S2=0
- FOR
- SET S2=$ORDER(^GMT(142,GMTSTYP,1,+Y(GMI),1,S2))
- if 'S2
- QUIT
- SET SEL=^(S2,0)
- SET GMTSEG(SEQ,S2)=SEL
- +3 QUIT