source: WorldVistAEHR/trunk/r/HEALTH_SUMMARY-GMTS/GMTSDS.m@ 1432

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

initial load of WorldVistAEHR

File size: 954 bytes
RevLine 
[613]1GMTSDS ; SLC/KER - Discharge Summary ; 09/21/2001
2 ;;2.7;Health Summary;**12,28,35,45,47**;Oct 20, 1995
3 ;
4 ; External References
5 ; DBIA 2902 MAIN^TIULAPIC
6 ; DBIA 10006 ^DIC (file #8935.1)
7 ;
8MAIN ; Control branching
9 N ADATE,ADMIT,ASUB,ATDATE,ATTNDNG,ATTYPE,ATYPE,AUTHOR,CHILD,CONEED
10 N COSAME,COSGEDBY,COSIG,CURIEN,DISCHG,GMTSA,GMTSAI,GMTSAII,GMTSCNT
11 N GMTSD,GMTSDIC,GMTSEXSG,GMTSI,GMTSIEN,GMTSII,GMTSIQ,GMTSJ,GMTSK
12 N GMTSODIC,GMTSPDIC,GMTSTDIC,GMTSPR,GMTSREC,GMTST,GMTSX,GMTSXTRA
13 N I,PARIEN,PDATE,PN,PSUB,PTYPE,REASON,SIGNEDBY,STATUS,TSPEC,TYPE
14 N TIUTYPE,TIUFPRIV,TIUNAM,GMTSTIUC,DIC,X,Y S (TIUNAM,X)="DISCHARGE SUMMARY",GMTSTIUC="DCS"
15 S DIC="^TIU(8925.1,",DIC(0)="X",DIC("S")="I $P($G(^(0)),U,4)=""CL"",$P($G(^(0)),U)=TIUNAM"
16 D ^DIC Q:+($G(Y))=0 S TIUTYPE=+Y K ^TMP("TIU",$J)
17 D MAIN^TIULAPIC(DFN,TIUTYPE,GMTS1,GMTS2,GMTSNDM,1)
18 Q:'$D(^TMP("TIU",$J)) D PNOTE^GMTSPN Q
Note: See TracBrowser for help on using the repository browser.