source: WorldVistAEHR/trunk/r/HINQ-DVB--DVBA--DVBE--DVBC/DVBHQUP.m@ 1005

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

initial load of WorldVistAEHR

File size: 5.8 KB
Line 
1DVBHQUP ;ALB/JLU This routine is used for the upload option. ; 3/9/06 4:16pm
2 ;;4.0;HINQ;**12,49,56**;03/25/92
3A D A^DVBHUTIL
4B W !
5B1 R !,"Do you want to examine the Suspense file by 'P'atient or 'A'll P// ",K1:DTIME G:'$T KA1 D P:"Pp"[K1!(K1=""),L:"Aa"[$E(K1_1)
6 G:DVBOUT="^" KA1
7 I K1="?"!(K1'="^") W !!,*7,?15,"Answer with capital A or P <RET> also for P",!! G B1
8KA1 D KA1^DVBHQEDT Q
9KA D KA^DVBHQEDT
10 Q
11P S K1="^" K DVBDIQ D P1 I Y<0 S DVBOUT="^" Q
12 N DVBQT,DVBTMP1,DVBTMP2
13 S DIE="^DPT(",(DA,DFN)=+Y,DR="[DVBHINQ UPDATE]",DVBJ2=0 D TEM^DVBHIQR
14 I '$D(DVBERCS) D CHKID^DVBHQD1
15 I $G(DVBQT) D G P
16 . S DVBTMP1=$G(DVBNOALR)
17 . S DVBTMP2=$G(DVBJ2)
18 . S DVBNOALR=";4///a;5////"_DUZ_";6///N",DVBJ2=1 D FILE
19 . S DVBNOALR=DVBTMP1
20 . S DVBJ2=DVBTMP2
21 D ^DIE:'$D(DVBERCS) K DIE,DR,DA
22 D C I DVBOUT'="^" G P
23 Q
24L S ANS="",K1="^"
25 I '$D(^DVB(395.5,"AC","N")) W !!,"No patients to be updated." H 3 Q
26 F K2=0:0 S K2=$O(^DVB(395.5,"AC","N",K2)) Q:'K2!(DVBOUT="^") D
27 . I $D(^DVB(395.5,K2,"RS",0)),$P(^DVB(395.5,K2,0),U,5)'="Y",$P(^(0),U,5)'="I" D
28 . . S DIE="^DPT(",(DA,DFN)=K2,DR="[DVBHINQ UPDATE]",DVBJ2=0 D TEM^DVBHIQR
29 . . N DVBQT,DVBTMP1,DVBTMP2
30 . . S DVBQT=1
31 . . I '$D(DVBERCS) D CHKID^DVBHQD1 I DVBQT D Q
32 . . . S DVBTMP1=$G(DVBNOALR)
33 . . . S DVBTMP2=$G(DVBJ2)
34 . . . S DVBNOALR=";4///a;5////"_DUZ_";6///N",DVBJ2=1 D FILE
35 . . . S DVBNOALR=DVBTMP1
36 . . . S DVBJ2=DVBTMP2
37 . . D ^DIE:'$D(DVBERCS) D C,KA Q:DVBOUT="^"
38 Q
39C ;SETS UPDATED? FIELD, RUNS INCONSIS. CHECKER.
40 Q:DVBOUT["^" S DVB=DFN,DVBLP=2,DVBMM=1,DVBMM2=1 D QB^DVBHQZ6
41 Q:'DVBJ2 I DVBJ2 S $P(^DVB(395.5,DFN,0),U,5)="Y" S DGEDCN=1 D ^DGRPC I 1
42 E S $P(^DVB(395.5,DFN,0),U,5)="N"
43 D FILE K DVBDIQ Q
44 ;
45 ;I '$D(^DVB(395.7,DFN,0)) K DIC,DD,DO S DIC(0)="LQ",DIC="^DVB(395.7,",DIC("DR")="1////"_DUZ_";2///"_"N",(X,DINUM)=DFN D FILE^DICN I 1
46 ;E S DIE="^DVB(395.7,",DA=DFN,DR="1////"_DUZ_";2///"_"N" D ^DIE
47 ;
48FILE I '$D(^DVB(395.7,DFN,0)) DO
49 .K DIC,DD,DO S DIC(0)="LQ",DIC="^DVB(395.7,"
50 .S DIC("DR")="1////"_DUZ_";2///"_"N"_$S($D(DVBNOALR):DVBNOALR,1:"")
51 .S (X,DINUM)=DFN D FILE^DICN
52 E DO
53 .K DIC S (DIC,DIE)="^DVB(395.7,",DA=DFN
54 .S DR="1////"_DUZ_";2///"_"N"_$S($D(DVBNOALR):DVBNOALR,1:"")
55 .I 'DVBJ2,$D(DVBNOALR),DVBNOALR]"" S DR=$E(DVBNOALR,2,99)
56 .L +^DVB(395.7,DFN):3 I $T D ^DIE
57 .L -^DVB(395.7,DFN)
58 K DIC,DIE,DA,DR Q
59 ;
60 ;ENRTY PT FOR PRINT OPTION
61PT W @$S('$D(IOF):"#",IOF="":"#",1:IOF),!!!!!!!!!!
62PT1 R "Do you want a print out of a (S)ingle patient or (A)ll of the patients? S// ",DVBJA:DTIME G:'$T KA1 D S:DVBJA="S"!(DVBJA=""),T:DVBJA="A"
63 I DVBJA="?"!(DVBJA'="^") W !!,*7,?15,"Answer with a capital A or S or <RET> for S",!! G PT1
64 D KA1 Q
65S D P1 I Y<0 S DVBJA="^" Q
66 S (DFN,D0,ZTSAVE("D0"),ZTSAVE("DFN"))=+Y,ZTRTN="S1^DVBHQUP" D RP I $D(IO("Q"))!POP S DVBJA="^" Q
67S1 U IO D TEM^DVBHIQR,^DVBHCG:'$D(DVBERCS) I '$D(ZTSK) X ^%ZIS("C")
68 S DVBJA="^" Q
69T S DVBJA="^",ZTRTN="RP1^DVBHQUP"
70 W !!,?6,"Select one of the following:",!!,?11,"1 Updated",!,?11,"2 NOT Updated",!,?11,"3 Both",!,"How would you like your print sorted? Updated//"
71 R Y:DTIME Q:Y="^"!('$T)
72 S (ZTSAVE("DVBY"),DVBY)=$S(Y=1!(Y="")!(Y["U"):1,Y=2!(Y["N"):2,Y=3!(Y["B"):3,1:"")
73 I DVBY="" W !!,*7,"Answer with a code from the list." G T
74 D CT Q
75 ;
76AU ;ENTRY POINT FOR DISPLAY OF AUDIT.
77 W @$S('$D(IOF):"#",IOF="":"#",1:IOF),!!!!!
78AU1 W !!,?6,"Select one of the following:",!!,?11,"1 Patient",!,?11,"2 User",!,?11,"3 Date/Time",!,"By which would you like the sort to begin? : Patient//"
79 R Y:DTIME Q:Y="^"!('$T)
80 S (FLDS,BY)=$S(Y=1!(Y="")!(Y["P"):"[DVBHINQ AUDIT/PAT]",Y=2!(Y["U"):"[DVBHINQ AUDIT/USER]",Y=3!(Y["D"):"[DVBHINQ AUDIT/DT]",1:"")
81 I BY="" W !!,*7,"Answer with a code from the above list." G AU1
82 S L=0,DIC="^DVB(395.7,",(FR,TO)="" D EN1^DIP Q
83 ;
84P1 W ! D KA S DIC="^DVB(395.5,",DIC(0)="AEMZQ",DIC("S")="I ($P(^(0),U,4)=""N""),($D(^(""RS"",0)))",DIC("A")="Select Patient from ""HINQ Suspense file"":" D ^DIC K DIC Q
85 ;
86RP S %IS="MQ" D ^%ZIS Q:POP I $D(IO("Q")) S ZTDESC="This is a job for the HINQ report.",ZTIO=ION D ^%ZTLOAD X ^%ZIS("C") Q
87 Q:DVBJA=""!(DVBJA="S")
88RP1 S DVB8="" U IO F D0=0:0 S (D0,DFN)=$O(^DVB(395.5,"AC","N",D0)) Q:'D0 S DVBJ1=$S((DVBY=1)&($P(^DVB(395.5,D0,0),U,5)="Y"):1,(DVBY=2)&($P(^(0),U,5)'="Y"):1,DVBY=3:1,1:0) D:DVBJ1 TEM^DVBHIQR,^DVBHCG:'$D(DVBERCS) Q:DVB8["^" D KA
89 I '$D(ZTSK) X ^%ZIS("C")
90 Q
91 ;
92CT S DVB1=0 F DVB=0:0 S DVB1=$O(^DVB(395.5,"AC","N",DVB1)) Q:'DVB1 S DVB=$S(DVBY=1&($P(^DVB(395.5,DVB1,0),U,5)="Y"):DVB+1,DVBY=2&($P(^(0),U,5)'="Y"):DVB+1,DVBY=3:DVB+1,1:DVB)
93 I 'DVB W !,"There are no patients at this time for this print." Q
94CT1 W !!,"There are ",DVB," patients for this report, do you wish to continue" S %=1 D YN^DICN Q:%=2!(%<0) I '% W !,"A YES answer will continue on with the report, answer with Y or N" G CT1
95 D RP Q
96LSTR ;lists the SC disabilities in the ReviewPatient vs. HINQ data
97 ;option, [DVB HUPLOAD-PRINT]
98 ;called from print template [DVBHINQ PAT-HINQ COMP]
99 N DVBIEN
100 K DVBERR
101 D GETS^DIQ(2,DFN_",",".302;.3014;.3721*","EI","DVBDIQ","DVBERR")
102 W "-Comb. SC%: "_+DVBDIQ(2,DFN_",",.302,"E")_" "
103 W "Eff. Date Comb. Eval.: "_DVBDIQ(2,DFN_",",.3014,"E")
104 I $P($G(^DPT(DFN,.372,0)),U,3)>0 D LABELS^DVBHS3
105 S LP=""
106 I $D(DVBDIQ(2.04)) F S LP=$O(DVBDIQ(2.04,LP)) Q:'LP D
107 . I ($Y+5)>IOSL,$E(IOST,1,2)="C-" D PAUSE^DVBHS3
108 . W !,$E(DVBDIQ(2.04,LP,.01,"E"),1,40),?42,DVBDIQ(2.04,LP,2,"E")
109 . W ?50,$G(DVBDIQ(2.04,LP,4,"I")),?55,$G(DVBDIQ(2.04,LP,5,"E"))
110 . W ?68,$G(DVBDIQ(2.04,LP,6,"E"))
111 Q
112 N DVBFR,DVBLAST,DVBX,QUIT
113 S DVBFR=""
114 S DVBLAST=$O(^DPT(DFN,.372,""),-1)
115 I $G(DVBLAST)']"" Q
116 F DVBX=0:0 D LOOP I $G(QUIT)=1!(DVBFR(2)>DVBLAST) K QUIT Q
117 Q
118LOOP ;
119 D LIST
120 N DVBCT
121 F DVBCT=0:0 S DVBCT=$O(DVBARR("DILIST",DVBCT)) Q:'DVBCT!(DVBCT>19) D
122 . W !?36,$P(DVBARR("DILIST",DVBCT,0),U,2),?68,$P(DVBARR("DILIST",DVBCT,0),U,4),?74,$P(DVBARR("DILIST",DVBCT,0),U,5)
123 D PAUSE^DVBHS3
124 Q
125LIST ;
126 D LIST^DIC(2.04,","_DFN_",",".01;2;3","P",20,.DVBFR,,,,,"DVBARR",)
127 I $G(DVBFR(2))'>0 S QUIT=1
128 Q
Note: See TracBrowser for help on using the repository browser.