APCDVDSP ; IHS/CMI/LAB -VISIT DISPLAY ;
;;2.0;IHS PCC SUITE;**2,4,5,10,11,17**;MAY 14, 2009;Build 18
;
EN ;PEP - can be called by other packages
;
Q:'$D(APCDVDSP)
Q:'APCDVDSP
Q:'$D(^AUPNVSIT(APCDVDSP,0))
D DSPLY
D EOJ
Q
;
DSPLY ;
I $D(IOF),'$D(APCDVDSP("NO IOF")) W @IOF
NEW D0,DA,DIC,DIQ,DR,DL,DK,DX,S
S APCDBRK=0 ;ACC
S APCDVDSH="-----------------------------"
S X="",$P(X,"~",80)="" W !!,X,!!,"VISIT IEN: ",APCDVDSP,!
S X="HRN: "_$$HRN^AUPNPAT($P(^AUPNVSIT(APCDVDSP,0),U,5),DUZ(2),2) W !,X,!
W APCDVDSH," VISIT FILE ",APCDVDSH
S DIC="^AUPNVSIT(",DA=APCDVDSP D EN^DIQ
DSPLY1 ;DISPLAY V FILE DATA
S APCDVFLE=9000010 F APCDVL=0:0 S APCDVFLE=$O(^DIC(APCDVFLE)) Q:APCDVFLE>9000010.99!(APCDVFLE'=+APCDVFLE)!(APCDBRK) D DSPLY2 Q:APCDBRK ;ACC
I 'APCDBRK S X="",$P(X,"~",80)="" W !!,X,!!
Q
;
DSPLY2 S APCDVNM=$P(^DIC(APCDVFLE,0),U)
S APCDVDG=^DIC(APCDVFLE,0,"GL"),APCDVIGR=APCDVDG_"""AD"",APCDVDSP,APCDVDFN)"
S APCDVDFN="",APCDVI=0 F S APCDVDFN=$O(@APCDVIGR) Q:APCDVDFN=""!(APCDBRK) D DSPLY3 Q:APCDBRK ;ACC
Q
;
DSPLY3 ;
I APCDVFLE=9000010.01 Q:$P($G(^AUPNVMSR(APCDVDFN,2)),U,1) ;meas entered in error
I APCDVFLE=9000010.54 Q:$P($G(^AUPNVRUP(APCDVDFN,2)),U,1) ;V updated/reviewed entered in error
I APCDVFLE=9000010.62 Q:$P($G(^AUPNVAMI(APCDVDFN,5)),U,1) ;V AMI entered in error
I APCDVFLE=9000010.63 Q:$P($G(^AUPNVSTR(APCDVDFN,5)),U,1) ;V STROKE entered in error
I APCDVFLE=9000010.51 Q:$P($G(^AUPNVACG(APCDVDFN,1)),U,1) ;V ANTICOAG entered in error
I APCDVFLE=9000010.58 Q:$P($G(^AUPNVVI(APCDVDFN,0)),U,6) ;V VI entered in error
I APCDVFLE=9000010.43 Q:$P($G(^AUPNVOB(APCDVDFN,0)),U,6) ;V OB entered in error
I $Y>(IOSL-5) D HEAD Q:APCDBRK
I $I(APCDVI)<2 S X=20-$L(APCDVNM),Y=X\2,Z=X-Y W !,APCDVDSH,$J("",Z),APCDVNM,$J("",Y),APCDVDSH
S DIC=APCDVDG,DA=APCDVDFN,DIQ(0)="C" D EN^DIQ
I APCDVFLE=9000010.28 S X=$P(^AUPNVNOT(APCDVDFN,0),U) I $$VAL^XBDIQ1(8925,X,.05)="RETRACTED" D
.W ?2,"DATE RETRACTED: ",$$VAL^XBDIQ1(8925,X,1611),!?2,"RETRACTED BY: ",$$VAL^XBDIQ1(8925,X,1610)
Q
;
HEAD ;
I '$D(ZTQUEUED),'$D(IO("S")),$E(IOST)="C",IO=IO(0) W !!,"Enter to continue, '^' to halt " R APCDX:DTIME S:'$T APCDBRK=1 S:APCDX="^" APCDBRK=1
Q:APCDBRK
K S
W:$D(IOF) @IOF
Q
EOJ ; EOJ CLEANUP
I '$D(ZTQUEUED),'$D(IO("S")),'APCDBRK,'$D(APCDEIN),$E(IOST)="C",IO=IO(0) W !,"End of visit display, <ENTER> to Continue" R APCDX:DTIME
K X,Y
K APCDVDFN,APCDVDG,APCDVDSH,APCDVDSP,APCDVFLE,APCDVI,APCDVIGR,APCDVL,APCDVNM,APCDX,APCDBRK
Q
APCDVDSP ; IHS/CMI/LAB -VISIT DISPLAY ;
+1 ;;2.0;IHS PCC SUITE;**2,4,5,10,11,17**;MAY 14, 2009;Build 18
+2 ;
EN ;PEP - can be called by other packages
+1 ;
+2 IF '$DATA(APCDVDSP)
QUIT
+3 IF 'APCDVDSP
QUIT
+4 IF '$DATA(^AUPNVSIT(APCDVDSP,0))
QUIT
+5 DO DSPLY
+6 DO EOJ
+7 QUIT
+8 ;
DSPLY ;
+1 IF $DATA(IOF)
IF '$DATA(APCDVDSP("NO IOF"))
WRITE @IOF
+2 NEW D0,DA,DIC,DIQ,DR,DL,DK,DX,S
+3 ;ACC
SET APCDBRK=0
+4 SET APCDVDSH="-----------------------------"
+5 SET X=""
SET $PIECE(X,"~",80)=""
WRITE !!,X,!!,"VISIT IEN: ",APCDVDSP,!
+6 SET X="HRN: "_$$HRN^AUPNPAT($PIECE(^AUPNVSIT(APCDVDSP,0),U,5),DUZ(2),2)
WRITE !,X,!
+7 WRITE APCDVDSH," VISIT FILE ",APCDVDSH
+8 SET DIC="^AUPNVSIT("
SET DA=APCDVDSP
DO EN^DIQ
DSPLY1 ;DISPLAY V FILE DATA
+1 ;ACC
SET APCDVFLE=9000010
FOR APCDVL=0:0
SET APCDVFLE=$ORDER(^DIC(APCDVFLE))
IF APCDVFLE>9000010.99!(APCDVFLE'=+APCDVFLE)!(APCDBRK)
QUIT
DO DSPLY2
IF APCDBRK
QUIT
+2 IF 'APCDBRK
SET X=""
SET $PIECE(X,"~",80)=""
WRITE !!,X,!!
+3 QUIT
+4 ;
DSPLY2 SET APCDVNM=$PIECE(^DIC(APCDVFLE,0),U)
+1 SET APCDVDG=^DIC(APCDVFLE,0,"GL")
SET APCDVIGR=APCDVDG_"""AD"",APCDVDSP,APCDVDFN)"
+2 ;ACC
SET APCDVDFN=""
SET APCDVI=0
FOR
SET APCDVDFN=$ORDER(@APCDVIGR)
IF APCDVDFN=""!(APCDBRK)
QUIT
DO DSPLY3
IF APCDBRK
QUIT
+3 QUIT
+4 ;
DSPLY3 ;
+1 ;meas entered in error
IF APCDVFLE=9000010.01
IF $PIECE($GET(^AUPNVMSR(APCDVDFN,2)),U,1)
QUIT
+2 ;V updated/reviewed entered in error
IF APCDVFLE=9000010.54
IF $PIECE($GET(^AUPNVRUP(APCDVDFN,2)),U,1)
QUIT
+3 ;V AMI entered in error
IF APCDVFLE=9000010.62
IF $PIECE($GET(^AUPNVAMI(APCDVDFN,5)),U,1)
QUIT
+4 ;V STROKE entered in error
IF APCDVFLE=9000010.63
IF $PIECE($GET(^AUPNVSTR(APCDVDFN,5)),U,1)
QUIT
+5 ;V ANTICOAG entered in error
IF APCDVFLE=9000010.51
IF $PIECE($GET(^AUPNVACG(APCDVDFN,1)),U,1)
QUIT
+6 ;V VI entered in error
IF APCDVFLE=9000010.58
IF $PIECE($GET(^AUPNVVI(APCDVDFN,0)),U,6)
QUIT
+7 ;V OB entered in error
IF APCDVFLE=9000010.43
IF $PIECE($GET(^AUPNVOB(APCDVDFN,0)),U,6)
QUIT
+8 IF $Y>(IOSL-5)
DO HEAD
IF APCDBRK
QUIT
+9
*** ERROR ***
IF $I(APCDVI)<2
SET X=20-$LENGTH(APCDVNM)
SET Y=X\2
SET Z=X-Y
WRITE !,APCDVDSH,$JUSTIFY("",Z),APCDVNM,$JUSTIFY("",Y),APCDVDSH
+10 SET DIC=APCDVDG
SET DA=APCDVDFN
SET DIQ(0)="C"
DO EN^DIQ
+11 IF APCDVFLE=9000010.28
SET X=$PIECE(^AUPNVNOT(APCDVDFN,0),U)
IF $$VAL^XBDIQ1(8925,X,.05)="RETRACTED"
Begin DoDot:1
+12 WRITE ?2,"DATE RETRACTED: ",$$VAL^XBDIQ1(8925,X,1611),!?2,"RETRACTED BY: ",$$VAL^XBDIQ1(8925,X,1610)
End DoDot:1
+13 QUIT
+14 ;
HEAD ;
+1 IF '$DATA(ZTQUEUED)
IF '$DATA(IO("S"))
IF $EXTRACT(IOST)="C"
IF IO=IO(0)
WRITE !!,"Enter to continue, '^' to halt "
READ APCDX:DTIME
IF '$TEST
SET APCDBRK=1
IF APCDX="^"
SET APCDBRK=1
+2 IF APCDBRK
QUIT
+3 KILL S
+4 IF $DATA(IOF)
WRITE @IOF
+5 QUIT
EOJ ; EOJ CLEANUP
+1 IF '$DATA(ZTQUEUED)
IF '$DATA(IO("S"))
IF 'APCDBRK
IF '$DATA(APCDEIN)
IF $EXTRACT(IOST)="C"
IF IO=IO(0)
WRITE !,"End of visit display, <ENTER> to Continue"
READ APCDX:DTIME
+2 KILL X,Y
+3 KILL APCDVDFN,APCDVDG,APCDVDSH,APCDVDSP,APCDVFLE,APCDVI,APCDVIGR,APCDVL,APCDVNM,APCDX,APCDBRK
+4 QUIT
