source: WorldVistAEHR/trunk/r/RECORD_TRACKING-RT/RTSM3.m

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

initial load of WorldVistAEHR

File size: 4.3 KB
Line 
1RTSM3 ;MJK,PKE/TROY ISC;Site Manager's Menu(cont); ; 5/18/87 10:20 AM ;
2 ;;v 2.0;Record Tracking;**14**;10/22/91
39 ;;Initialize Records
4 D BOTH^RTSM Q:'$D(RADPT)
5 W !!?5,"This option will use the patients in the",$S(RADPT:" RADIOLOGY",1:"")," PATIENT file"
6 W !?5,"as a base to create the necessary ",$S(RADPT:"film jacket",1:"folder")," entries in the"
7 W !?5,"RECORDS file. <This option does not print barcode labels.>"
8 ;
9NUM S Y=$S($D(^TMP("RTDFNSTART",+RTAPL)):+^(+RTAPL),1:1) W !!,"Start at DFN: ",Y,"// " R X:DTIME S:X="" X=Y W:X["?" !!,"Enter a number." G NUM:X["?",Q9:'$T!('X)!(X'?.N) S ^(+RTAPL)=X
10 K RTERM,RTION,^TMP($J) S RTLOAD="LOAD^RTSM3",RTMES1=$S('RADPT:"MAS Patient Folder",1:"Radiology Film Jacket Entry")_" Creation:" G LOAD^RTSM1
11Q9 K RADPT
12 K X,%I,D Q
13 ;
1410 ;;Patient Record Labels
15 S RTLOAD="PAT^RTSM3"
16ASK D BOTH^RTSM G Q10:'$D(RADPT) S RTMES1=$S(RTLOAD["PAT":"P",1:"Inp")_"atient '"_$S(RADPT:"Film Jacket",1:"MAS Folder")_"' Label Creation:"
17 K RTLDIV
18 S RTRD(4)="Ldivision, Name^,for Last Registration, sort by name of patient"
19 S RTRD(3)="Division, Digits^,for Last Registration, sort by Terminal digits"
20 S RTRD(1)="Name^sort labels by name of patient"
21 S RTRD(2)="Terminal Digits^sort by last 2 numbers of SSN",RTRD("B")=2,RTRD("A")="Sort sequence for labels? ",RTRD(0)="S" D SET^RTRD K RTRD S (X,RTXX)=$E(X) I X'="N",X'="T",X'="D",X'="L" G Q10
22 G ASK1:RTLOAD["IN"!(X="N")!(X="L")
23 ;I '$D(^UTILITY("RTDPTSORT","START")) W !!,*7,"The ^UTILITY(""RTDPTSORT"") global does NOT exist." D CHKQ^RTSM4 G Q10
24 ;I $D(^UTILITY("RTDPTSORT","START")),'$D(^("FINISH")) S S=+$P(^("START"),"^",2) W !!,*7,"The ^UTILITY(""RTDPTSORT"") global is currently being compiled." D CHK^RTSM4 G Q10
25 ;
26 I $D(^RTV(194.3,1,0)),($E($P(^(0),"^",3),1,3))'=($E(DT,1,3)) DO Q
27 .W !!,*7,"The RECORD TRACKING SORT GLOBAL file(#194.3) "
28 .I '$P(^(0),"^",2),'$P(^(0),"^",3) W "needs to be compiled"
29 .;naked ref rtv(194.3,1,0)
30 .E I '$P(^(0),"^",3) W "is currently being compiled" D Q10 Q
31 .E W "needs additional compiling"
32 .D CHKQ^RTSM4,Q10
33 ;
34ASK1 K RTERM I "TD"[RTXX D TERM^RTSM2 G Q10:'$D(RTERM) I RTXX="D" K RTLDIV D ^RTLDIV G Q10:'$D(RTLDIV)
35 I RTXX="L" K RTLDIV D NAM^RTLDIV G Q10:'$D(RTLDIV)
36 S:'$D(RTERM) RTERM="NAME" D PRT G LOAD^RTSM1:$D(RTION)
37Q10 K RADPT,RTLOAD,RTMES1,RTERM
38 K RTCXX,RTLDIV,X,J,DUOUT,RTXX,RTSTART Q
39 ;
40LOAD S DFN=$S($D(^TMP("RTDFNSTART",+RTAPL)):^(+RTAPL)-1,1:0)
41 F DFN=DFN:0 S DFN=$O(^DPT(DFN)) Q:'DFN I $D(^DPT(DFN,0)),$S('RADPT:1,$D(^RADPT(DFN,0)):1,1:0) S RTE=DFN_";DPT(" D RTTY^RTSM1 S ^TMP("RTDFNSTART",+RTAPL)=DFN
42 K DFN Q
43 ;
44PAT ;Patient Label Creation
45 I RTERM'="NAME" D PAT0 I 1
46 E D PAT1
47 K RTRM0,RTRM1,DFN,RTNME,RTNME0,RTRM,RTTD,DFN Q
48 ;
49PAT0 F RTRM0=1:1 S RTRM=$P(RTERM,"^",RTRM0) Q:RTRM="" DO
50 .S RTTD=$S($D(RTSTART):RTSTART,1:RTRM_"0000000") K RTSTART
51 .S RTRM1=0
52 .FOR S RTTD=$O(^RTV(194.3,1,1,"AC",RTTD)) Q:$E(RTTD,1,2)'=RTRM!(RTTD="") DO
53 . .S DFN=0
54 . .F S DFN=$O(^RTV(194.3,1,1,"AC",RTTD,DFN)) Q:'DFN S X=^(DFN) D LB
55 Q
56PAT1 S RTNME="" F RTNME0=0:0 S RTNME=$O(^DPT("B",RTNME)) Q:RTNME="" F DFN=0:0 S DFN=$O(^DPT("B",RTNME,DFN)) Q:'DFN D:'$D(RTLDIV) LBL I $D(RTLDIV) S X=$O(^DPT(DFN,"DIS",0)) S X=$S('X:"",'$D(^(X,0)):"",X:$P(^(0),"^",4),1:"") D LB
57 Q
58LB I $D(RTLDIV) S RTLDV="^"_X_"^" I RTLDIV'[RTLDV K X,RTLDV Q
59 ;
60 ;
61LBL I $D(^DPT(DFN,0)),$S('$D(^(.35)):1,'^(.35):1,1:0),$S('RADPT:1,$D(^RADPT(DFN,0)):1,1:0) S RTE=DFN_";DPT(" D RTTY^RTSM1 K RTE Q
62 Q
63 ;
6411 ;;Inpatient Labels
65 S RTLOAD="IN^RTSM3" G ASK
66 ;
67IN ;Inpatient Label
68 S RTWARD="" F RTWARD1=0:0 S RTWARD=$O(^DPT("CN",RTWARD)) Q:RTWARD="" F DFN=0:0 S DFN=$O(^DPT("CN",RTWARD,DFN)) Q:'DFN D DFN:$S('RADPT:1,$D(^RADPT(DFN,0)):1,1:0)
69 W !!,"Printing Labels..." S RTSORT=""
70 F RTSORT1=0:0 S RTSORT=$O(^TMP($J,"RTSORT",RTSORT)) Q:RTSORT="" F DFN=0:0 S DFN=$O(^TMP($J,"RTSORT",RTSORT,DFN)) Q:'DFN S RTE=DFN_";DPT(" D RTTY^RTSM1:$D(^DPT(DFN,.1))
71 K RTWARD,RTWARD1,DFN,RTE,RTSORT,RTSORT1
72 K RTXX,X1 Q
73DFN Q:'$D(^DPT(DFN,0)) S X=^(0) I RTERM'="NAME" S X=$P(^(0),"^",9) I X S:$D(RTERM($E(X,8,9))) ^TMP($J,"RTSORT",$E(X,8,9)_$E(X,6,7)_$E(X,1,5),DFN)="" Q
74 I X S ^TMP($J,"RTSORT",$P(X,"^"),DFN)="" Q
75 Q
76 ;add check for barcode field, screen for virtual term?
77PRT K RTION S DIC(0)="IAEMQ",DIC="^%ZIS(1,",DIC("A")="Select Label Printer: ",DIC("S")="I $D(^(""SUBTYPE"")),$D(^%ZIS(2,+^(""SUBTYPE""),0)),$E(^(0))=""P""" D ^DIC K DIC Q:Y<0 S RTION=$P(Y,"^",2)
78 Q
79 ;
Note: See TracBrowser for help on using the repository browser.