source: FOIAVistA/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIULD.m@ 1765

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

initial load of FOIAVistA 6/30/08 version

File size: 3.4 KB
Line 
1TIULD ; SLC/JER - Admission related functions ; 1/13/03
2 ;;1.0;TEXT INTEGRATION UTILITIES;**7,21,148,156**;Jun 20, 1997
3GETTIU(TIUY,TIUDA) ; Gets admission array for existing DCS
4 N TIUMVN,TIUPTF,TIUVSTR,TIUDTYP,TIUD0,TIUD12,TIUD14
5 S TIUD0=$G(^TIU(8925,+TIUDA,0)),TIUD12=$G(^(12)),TIUD14=$G(^(14))
6 S TIUDTYP=+TIUD0,DFN=+$P(TIUD0,U,2),TIUMVN=$P(TIUD14,U)
7 S TIUVSTR=$P(TIUD12,U,11)_";"_$P(TIUD0,U,7)_";"_$P(TIUD0,U,13)
8 S TIUY("DOCTYP")=TIUDTYP_U_$$PNAME^TIULC1(TIUDTYP)
9 I +$G(^TIU(8925,+TIUDA,13)) S TIUY("REFDT")=+$G(^(13))
10 ; If the Patient Movement Pointer's broken, try to fix
11 I +TIUMVN,'$D(^DGPM(+TIUMVN,0)),+$G(TIUVSTR) D FIXMOVE(.TIUY,DFN,TIUVSTR,TIUDA) Q:+$G(TIUY("AD#"))
12 D PATVADPT^TIULV(.TIUY,DFN,TIUMVN,TIUVSTR)
13 Q
14FIXMOVE(TIUY,DFN,TIUVSTR,TIUDA) ; See if Admission has been reinstated, and fix
15 N TIUEDT,TIULDT,TIULOC
16 S TIUEDT=$P(TIUVSTR,";",2) Q:+TIUEDT'>0
17 S TIULDT=$$FMADD^XLFDT(TIUEDT,1),TIULOC=+TIUVSTR
18 Q:+TIULDT'>0!(+TIULOC'>0)
19 D MAIN^TIUMOVE(.TIUY,DFN,"",TIUEDT,TIULDT,1,"LAST",0,+TIULOC)
20 I +$G(TIU("AD#"))>0,$D(^DGPM(+$G(TIU("AD#")))) D
21 . N DIE,DR,DA S DA=TIUDA,DR="1401////"_+$G(TIU("AD#")),DIE="^TIU(8925,"
22 . D ^DIE
23 Q
24CHEKDS(X) ; Display/validate correct patient/treatment episode
25 N DIR,Y,TIURC S Y=0
26 I X("AD#")'>0!(X("EDT")="") D G CHEKDSX
27 . W !!,"Movement data doesn't exist for admission, can't create "
28 . W "Summary",!
29 I +$$ISA^USRLM(DUZ,"TRANSCRIPTIONIST")>0 S Y=1 G CHEKDSX
30 W !!?1,"Patient: ",$$NAME^TIULS(X("PNM"),"LAST, FIRST MI"),?40,"SSN: "
31 W X("SSN"),?62,"Sex: ",$S(X("SEX")]"":$P(X("SEX"),U,2),1:"UNKNOWN"),!
32 W ?5,"Age: ",$S(X("AGE")]"":X("AGE"),1:"UNKNOWN"),?40,"Claim #: "
33 W $S(X("CLAIM")]"":X("CLAIM"),1:"UNKNOWN"),!
34 W "Adm Date: ",$$DATE^TIULS($P(X("EDT"),U),"MM/DD/YY"),?40,"Ward: "
35 W $P(X("WARD"),U,2),!
36 W:X("LDT")]"" "Dis Date: ",$$DATE^TIULS(X("LDT"),"MM/DD/YY"),!
37 W ?2,"Adm Dx: ",X("ADDX")
38 ; Below TIU*148
39 I $G(X("NUMRACE"))>0 D
40 . W !?4,"Race: " F TIURC=1:1:X("NUMRACE") W ?10,$P(X("RACE",TIURC),U,2),!
41 I $G(X("RACENO"))=0 W !?4,"Race: ",$P($G(X("RACE")),U,2),!
42 I $D(X("DICTDT")) D
43 . W !,"A DISCHARGE SUMMARY is already on file:",!
44 . W ?2,"Dict'd: ",X("DICTDT"),?41,"By: ",X("AUTHOR"),!
45 . W ?2,"Signed: ",X("SIGDT"),?35,"Cosigned: ",X("COSDT"),!
46 . S Y=1
47 E S Y=$$READ^TIUU("YO","Correct VISIT","YES")
48 W !
49CHEKDSX Q Y
50CHEKPN(X,TIUBY) ; Display/validate demographic/visit information
51 W !!,"Enter/Edit "
52 W $S(+$G(TIUCLASS):$S(TIUCLASS=3:"PROGRESS NOTE",TIUCLASS=+$$CLASS^TIUCNSLT:"CONSULT RESULT",1:$$PNAME^TIULC1(+TIUCLASS)),1:"PROGRESS NOTE"),"..."
53 W !?10,"Patient Location: ",$S(+X("LOC"):$P(X("LOC"),U,2),1:"UNKNOWN")
54 W !?$S(+$G(X("AD#")):4,1:8),"Date/time of "
55 W $S(+$G(X("AD#")):"Admission: ",1:"Visit: ")
56 W $S(+$P($G(X("VSTR")),";",2):$$DATE^TIULS($P(X("VSTR"),";",2),"MM/DD/YY HR:MIN"),1:"UNKNOWN")
57 W !?9,"Date/time of Note: "
58 W $S(+$G(X("REFDT"))>0:$$DATE^TIULS(X("REFDT"),"MM/DD/YY HR:MIN"),1:"NOW")
59 S:+$G(X("REFDT"))'>0 X("REFDT")=$$NOW^TIULC
60 W !?12,"Author of Note: "
61 W $$PERSNAME^TIULC1($S($D(TIUAUTH):+TIUAUTH,1:DUZ))
62 S Y=$$READ^TIUU("YO"," ...OK","YES")
63 I $S($D(DIROUT):1,$D(DUOUT):1,$D(DTOUT):1,1:0) Q 0
64 S TIUBY=+Y
65 S:'+Y Y=$$READ^TIUU("YO","Correct VISIT","YES")
66 I $S($D(DIROUT):1,$D(DUOUT):1,$D(DTOUT):1,1:0) Q 0
67 I +Y'>0 D
68 . K X N TIUINOUT
69 . S TIUINOUT=$$INOUT^TIUVSIT
70 . I $S($D(DIROUT):1,$D(DUOUT):1,$D(DTOUT):1,1:0) Q
71 . I $P(TIUINOUT,U)="o" D MAIN^TIUVSIT(.X,DFN,"","","","",1)
72 . I $P(TIUINOUT,U)'="o" D MAIN^TIUMOVE(.X,DFN,"","","",1,"LAST",1)
73 . S Y=$S($D(X)>9:$$CHEKPN(.X,.TIUBY),1:0)
74 Q Y
Note: See TracBrowser for help on using the repository browser.