source: FOIAVistA/trunk/r/HEALTH_SUMMARY-GMTS/GMTSADH1.m@ 1397

Last change on this file since 1397 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.8 KB
Line 
1GMTSADH1 ;SLC/JER,MAM - Ad Hoc Summary Driver ; 09/21/2001
2 ;;2.7;Health Summary;**1,37,47**;Oct 20, 1995
3 ;
4 ; External References
5 ; DBIA 10026 ^DIR
6 ; DBIA 10140 EN^XQORM
7 ;
8GETLIM ; Get Limits/Flags (external entry)
9 ;
10 ; Time
11 ; Occurrence
12 ; Selection Items
13 ; Hospital Location Display
14 ; ICD Text Display
15 ; Provider Narrative Display
16 ; CPT Modifier Display
17 ;
18 N LISTFLG,GMCHANGE,GMW,QUIT S GMCHANGE=0 D LIST
19 F S LISTFLG=0 D ASKCMPS Q:$D(QUIT)!$D(DIROUT)
20 Q
21LIST ; Lists defaults for Ad Hoc Summary
22 S LISTFLG=1,GMCHANGE=0
23 W @IOF,!," Default Limits and Selection Items",!!
24 W " Component Occ Time Hosp ICD Prov CPT Selection",!
25 W " Limit Limit Loc Txt Narr Mod Item(s)",!
26 N FLG,DTOUT S FLG=0
27LIST1 ; Called by GMTSUP to list components
28 ; FLG=1 for Ad Hoc Health Summary Type
29 ; FLG=2 for other Health Summary Types
30 N GMI,DIR,DUOUT,GMW S DIR(0)="E"
31 S GMI=0 F S GMI=$O(GMTSEG(GMI)) Q:GMI'>0 D SCRNLNTH Q:$D(DUOUT)!($D(DTOUT)) D LISTLIM D:($D(GMTSEG(GMI))=11)&('FLG) LISTSEL Q:$D(DUOUT)!($D(DTOUT))
32 Q
33SCRNLNTH ; Checks screen length
34 I $Y>(IOSL-4) W ! D ^DIR S:$D(DTOUT) DIROUT="" Q:$D(DUOUT)!($D(DTOUT)) W @IOF
35 Q
36 ;
37LISTLIM ; List Components and Limits for GMTSET() array
38 ; Component Abbreviation
39 ; Component Name
40 ; If not called by GMTSUP:
41 ; Time Limits
42 ; Occurrence Limits
43 ; Hospital Location
44 ; ICD Text
45 ; Provider Narrative
46 ; CPT Modifier
47 ;
48 N CREC S CREC=^GMT(142.1,$P(GMTSEG(GMI),U,2),0) W ! I FLG=2 D STAR
49 W $P(CREC,U,4),?5,$S($L($P(GMTSEG(GMI),U,5)):$P(GMTSEG(GMI),U,5),$L($P(CREC,U,9)):$P(CREC,U,9),1:$E($P(CREC,U),1,24))
50 W:'FLG ?28,$P(GMTSEG(GMI),U,3),?35,$P(GMTSEG(GMI),U,4)
51 W:'FLG ?42,$P(GMTSEG(GMI),U,6),?48,$E($P(GMTSEG(GMI),U,7),1,5)
52 W:'FLG ?53,$P(GMTSEG(GMI),U,8),?59,$P(GMTSEG(GMI),U,9)
53 Q
54STAR ; Writes * to indicate added component when called by
55 ; GMTSUP for Health Summary Type other than AD HOC
56 I $D(^GMT(142,+($G(GMTSTYP)),1,"C",$P(GMTSEG(GMI),U,2))) W " "
57 E W "*"
58 Q
59LISTSEL ; Lists default selection items
60 N GMW,GMJ,GML S GMJ=$O(GMTSEG(GMI,0)),GML=0
61 F GMW=1:1 S GML=$O(GMTSEG(GMI,GMJ,GML)) Q:GML="" D SCRNLNTH Q:$D(DUOUT)!($D(DTOUT)) W:GMW'=1 ! W ?64,$E($P(@(GMTSEG(GMI,GMJ,0)_GMTSEG(GMI,GMJ,GML)_",0)"),U),1,15)
62 Q
63ASKCMPS ; Asks for components for new limits/sel items
64 N GMI,GMW,GMX,ASKCPQIT,DIC,X,XQORM,Y I LISTFLG D
65 . W !!,"To change limits, selection items, hospital location display, ICD"
66 . W !,"text display, provider narrative display, or CPT Modifiers, enter "
67 . W !,"components, one at a time or more than one, separated by commas."
68 . W !,"You may select new components if you wish."
69 S XQORM=GMTSTYP_";GMT(142,",XQORM("??")="D HELP^GMTSADH3"
70 S XQORM(0)="A",XQORM("A")="Select COMPONENT(S) to EDIT or other COMPONENT(S) to ADD: "
71 D EN^XQORM S:$D(DTOUT)!(X="^^") (DIROUT,QUIT)=1 I $D(DIROUT) Q
72 I +Y,(X?1"^^".E) G ASKCMPS
73 I $S(X="^":1,X=""&(GMCHANGE=0):1,1:0) S QUIT="" Q
74 I X="",GMCHANGE D ASKLIST Q
75 I X["^" W " ??" Q
76 S GMCHANGE=1,GMI=0 F S GMI=$O(Y(GMI)) Q:GMI="" S GMX=^GMT(142,+GMTSTYP,1,+Y(GMI),0) W !!,$P(Y(GMI),U,3) D CMPCOND Q:$D(DUOUT)!($D(DIROUT))
77 S:'$D(DIROUT) LISTFLG=1
78 Q
79CMPCOND ; Checks component for new limits/sel items
80 N OLD,SBS,CREC,SREC,STRN,CPCDQIT S OLD=0 I $D(GMTSEGI($P(GMX,U,2))) S SBS=GMTSEGI($P(GMX,U,2)),OLD=1
81 S CREC=^GMT(142.1,$P(GMX,U,2),0)
82 I OLD=0 S GMTSEGC=GMTSEGC+1,SREC=GMX,STRN=+GMX D LOAD1^GMTSADH S SBS=GMJ
83 D CMPLIM^GMTSADH2
84 Q
85ASKLIST ; Asks whether to relist Component
86 N DIR,X,Y S DIR(0)="YA",DIR("A")="Would you like to see Component Limits and Selection Items again? (Y/N): ",DIR("B")="NO" W !
87 D ^DIR I Y'>0,(GMCHANGE=1) S QUIT=1 Q
88 S:$D(DTOUT) DIROUT=1 I $D(DIROUT) Q
89 I $D(DIRUT),'$D(DUOUT) W " ??"
90 I $D(DIRUT)!(Y=0) Q
91 D LIST
92 Q
Note: See TracBrowser for help on using the repository browser.