Routine: DVBHQUP

DVBHQUP ;ALB/JLU  This routine is used for the upload option. ; 3/9/06 4:16pm

 ;;4.0;HINQ;**12,49,56**;03/25/92

A D A^DVBHUTIL

B W !

B1 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)

 G:DVBOUT="^" KA1

 I K1="?"!(K1'="^") W !!,*7,?15,"Answer with capital A or P <RET> also for P",!! G B1

KA1 D KA1^DVBHQEDT Q

KA D KA^DVBHQEDT

P S K1="^" K DVBDIQ D P1 I Y<0 S DVBOUT="^" Q

 N DVBQT,DVBTMP1,DVBTMP2

 S DIE="^DPT(",(DA,DFN)=+Y,DR="[DVBHINQ UPDATE]",DVBJ2=0 D TEM^DVBHIQR

 I '$D(DVBERCS) D CHKID^DVBHQD1

 I $G(DVBQT) D  G P

 . S DVBTMP1=$G(DVBNOALR)

 . S DVBTMP2=$G(DVBJ2)

 . S DVBNOALR=";4///a;5////"_DUZ_";6///N",DVBJ2=1 D FILE

 . S DVBNOALR=DVBTMP1

 . S DVBJ2=DVBTMP2

 D ^DIE:'$D(DVBERCS) K DIE,DR,DA

 D C I DVBOUT'="^" G P

L S ANS="",K1="^"

 I '$D(^DVB(395.5,"AC","N")) W !!,"No patients to be updated." H 3 Q

 F K2=0:0 S K2=$O(^DVB(395.5,"AC","N",K2)) Q:'K2!(DVBOUT="^")  D

 . I $D(^DVB(395.5,K2,"RS",0)),$P(^DVB(395.5,K2,0),U,5)'="Y",$P(^(0),U,5)'="I" D

 . . S DIE="^DPT(",(DA,DFN)=K2,DR="[DVBHINQ UPDATE]",DVBJ2=0 D TEM^DVBHIQR

 . . N DVBQT,DVBTMP1,DVBTMP2

 . . S DVBQT=1

 . . I '$D(DVBERCS) D CHKID^DVBHQD1 I DVBQT D  Q

 . . . S DVBTMP1=$G(DVBNOALR)

 . . . S DVBTMP2=$G(DVBJ2)

 . . . S DVBNOALR=";4///a;5////"_DUZ_";6///N",DVBJ2=1 D FILE

 . . . S DVBNOALR=DVBTMP1

 . . . S DVBJ2=DVBTMP2

 . . D ^DIE:'$D(DVBERCS) D C,KA Q:DVBOUT="^"

C ;SETS UPDATED? FIELD, RUNS INCONSIS. CHECKER.

 Q:DVBOUT["^"  S DVB=DFN,DVBLP=2,DVBMM=1,DVBMM2=1 D QB^DVBHQZ6

 Q:'DVBJ2  I DVBJ2 S $P(^DVB(395.5,DFN,0),U,5)="Y" S DGEDCN=1 D ^DGRPC I 1

 E  S $P(^DVB(395.5,DFN,0),U,5)="N"

 D FILE K DVBDIQ Q

 ;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

 ;E  S DIE="^DVB(395.7,",DA=DFN,DR="1////"_DUZ_";2///"_"N" D ^DIE

FILE I '$D(^DVB(395.7,DFN,0)) DO

 .K DIC,DD,DO S DIC(0)="LQ",DIC="^DVB(395.7,"

 .S DIC("DR")="1////"_DUZ_";2///"_"N"_$S($D(DVBNOALR):DVBNOALR,1:"")

 .S (X,DINUM)=DFN D FILE^DICN

 E  DO

 .K DIC S (DIC,DIE)="^DVB(395.7,",DA=DFN

 .S DR="1////"_DUZ_";2///"_"N"_$S($D(DVBNOALR):DVBNOALR,1:"")

 .I 'DVBJ2,$D(DVBNOALR),DVBNOALR]"" S DR=$E(DVBNOALR,2,99)

 .L +^DVB(395.7,DFN):3 I $T D ^DIE

 .L -^DVB(395.7,DFN)

 K DIC,DIE,DA,DR Q

 ;ENRTY PT FOR PRINT OPTION

PT W @$S('$D(IOF):"#",IOF="":"#",1:IOF),!!!!!!!!!!

PT1 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"

 I DVBJA="?"!(DVBJA'="^") W !!,*7,?15,"Answer with a capital A or S or <RET> for S",!! G PT1

 D KA1 Q

S D P1 I Y<0 S DVBJA="^" Q

 S (DFN,D0,ZTSAVE("D0"),ZTSAVE("DFN"))=+Y,ZTRTN="S1^DVBHQUP" D RP I $D(IO("Q"))!POP S DVBJA="^" Q

S1 U IO D TEM^DVBHIQR,^DVBHCG:'$D(DVBERCS) I '$D(ZTSK) X ^%ZIS("C")

 S DVBJA="^" Q

T S DVBJA="^",ZTRTN="RP1^DVBHQUP"

 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//"

 R Y:DTIME Q:Y="^"!('$T)

 S (ZTSAVE("DVBY"),DVBY)=$S(Y=1!(Y="")!(Y["U"):1,Y=2!(Y["N"):2,Y=3!(Y["B"):3,1:"")

 I DVBY="" W !!,*7,"Answer with a code from the list." G T

 D CT Q

AU ;ENTRY POINT FOR DISPLAY OF AUDIT.

 W @$S('$D(IOF):"#",IOF="":"#",1:IOF),!!!!!

AU1 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//"

 R Y:DTIME Q:Y="^"!('$T)

 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:"")

 I BY="" W !!,*7,"Answer with a code from the above list." G AU1

 S L=0,DIC="^DVB(395.7,",(FR,TO)="" D EN1^DIP Q

P1 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

RP 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

 Q:DVBJA=""!(DVBJA="S")

RP1 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

 I '$D(ZTSK) X ^%ZIS("C")

CT 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)

 I 'DVB W !,"There are no patients at this time for this print." Q

CT1 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

 D RP Q

LSTR ;lists the SC disabilities in the ReviewPatient vs. HINQ data

 ;option, [DVB HUPLOAD-PRINT]

 ;called from print template [DVBHINQ PAT-HINQ COMP]

 N DVBIEN

 K DVBERR

 D GETS^DIQ(2,DFN_",",".302;.3014;.3721*","EI","DVBDIQ","DVBERR")

 W "-Comb. SC%: "_+DVBDIQ(2,DFN_",",.302,"E")_"  "

 W "Eff. Date Comb. Eval.: "_DVBDIQ(2,DFN_",",.3014,"E")

 I $P($G(^DPT(DFN,.372,0)),U,3)>0 D LABELS^DVBHS3

 S LP=""

 I $D(DVBDIQ(2.04)) F  S LP=$O(DVBDIQ(2.04,LP)) Q:'LP  D

 . I ($Y+5)>IOSL,$E(IOST,1,2)="C-" D PAUSE^DVBHS3

 . W !,$E(DVBDIQ(2.04,LP,.01,"E"),1,40),?42,DVBDIQ(2.04,LP,2,"E")

 . W ?50,$G(DVBDIQ(2.04,LP,4,"I")),?55,$G(DVBDIQ(2.04,LP,5,"E"))

 . W ?68,$G(DVBDIQ(2.04,LP,6,"E"))

 N DVBFR,DVBLAST,DVBX,QUIT

 S DVBFR=""

 S DVBLAST=$O(^DPT(DFN,.372,""),-1)

 I $G(DVBLAST)']"" Q

 F DVBX=0:0 D LOOP I $G(QUIT)=1!(DVBFR(2)>DVBLAST) K QUIT Q

LOOP ;

 D LIST

 N DVBCT

 F DVBCT=0:0  S DVBCT=$O(DVBARR("DILIST",DVBCT)) Q:'DVBCT!(DVBCT>19)  D

 . 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)

 D PAUSE^DVBHS3

LIST ;

 D LIST^DIC(2.04,","_DFN_",",".01;2;3","P",20,.DVBFR,,,,,"DVBARR",)

 I $G(DVBFR(2))'>0 S QUIT=1

DVBHQUP.m