MCARAP1 ;WASH ISC/SAE-MEDICINE AUTO INSTRUMENT INTERFACE SUMMARY PRINT ;5/7/96 13:43
;;2.3;Medicine;;09/13/1996
;
PRINT ; Print Report
S PG=0,(TOTS,TOTU)=0 K REDO
D NOW^%DTC S Y=% D DD^%DT S MCNOW=$E(Y,1,18),MCDAY=$E(Y,1,12),MCTIME=$E(Y,13,18)
D HEAD
S PDATE=DATE1 D PRINT1 F PJ=0:0 S PDATE=$O(^MCAR(700.5,"C",PDATE)) D:PDATE="" WSTAT D:$P(PDATE,".")>DATE2 WSTAT G EXIT:PDATE="",EXIT:$P(PDATE,".")>DATE2 D STYPE I $D(TYPE) K TYPE D PRINT1 G:$D(EXIT) EXIT1
Q
PRINT1 S ENTRY=0 F IJ=0:0 S ENTRY=$O(^MCAR(700.5,"C",PDATE,ENTRY)) Q:ENTRY="" D STAT,PAGE Q:$D(EXIT) D WRITE
Q
WRITE ; Write report line
I $D(NAME),(NAME'=$P(^MCAR(700.5,ENTRY,0),U,4)) Q
I $D(BAD),($P(^MCAR(700.5,ENTRY,0),U,8)="S") Q
I $D(GOOD),($P(^MCAR(700.5,ENTRY,0),U,8)="U") Q
S DTT=$P(^MCAR(700.5,ENTRY,0),U),INST=$P(^(0),U,2),SSN=$P(^(0),U,3),P=$P(^(0),U,4),ERR=$P(^(0),U,5),DTI=$P(^(0),U,6),TRIES=$P(^(0),U,7),FLAG=$P(^(0),U,8),DTL=$P(^(0),U,9)
S Y=DTT D DD^%DT S DTT=Y,Y=DTI D DD^%DT S DTI=$E(Y,1,18),Y=DTL D DD^%DT S DTL=$E(Y,1,18)
W !,$P(DTT,"@"),?14,DTI,?34,P,?60,SSN,?71,TRIES,?76,ERR,!,?6,$E(DTT,13,18),?14,DTL
Q
HEAD ; Header
S PG=PG+1 W @IOF,!,?18,"VETERANS ADMINISTRATION MEDICAL CENTER",?72,"Page ",PG
;W !,?28,^DD("SITE"),?66,MCDAY
W !,?28,$$GET1^DIQ(4.3,1,217),?66,MCDAY
W:$D(GOOD) !,?14,"SUMMARY OF SUCCESSFUL RECORD TRANSFER ATTEMPTS",?72,MCTIME
W:$D(BAD) !,?13,"SUMMARY OF UNSUCCESSFUL RECORD TRANSFER ATTEMPTS",?72,MCTIME
W:$D(ALL) !,?17,"SUMMARY OF ALL RECORD TRANSFER ATTEMPTS",?72,MCTIME
K DATESAME S:DATE1=DATE2 DATESAME=1
W:$D(DATESAME) !,?24 W:'$D(DATESAME) !,?19 W "DHCP ("
S Y=DATE1 D DD^%DT S EDATE1=Y,Y=DATE2 D DD^%DT S EDATE2=Y
W:$D(DATESAME) EDATE1,")" W:'$D(DATESAME) EDATE1," - ",EDATE2,")"
W !!,"TEST DATE",?17,"FIRST TRANS",?37,"PATIENT",?63,"SSN",?69,"TRIES",?76,"ERR",!,"TEST TIME",?17,"LAST TRANS"
S DASH="",$P(DASH,"-",80)="" W !,DASH
Q
EXIT ; Exit from program
I IOST'?1"P-".E R !!,"Press return to continue, or '^' to escape: ",X:DTIME
G EXIT1:'$T,EXIT1:X=U,^MCARAP
EXIT1 K GOOD,BAD,ALL,J,DIK,ENTRY,DATE1,DATE2,IJ,PG,RPT,DA,%,%DT,ZIP,%ZIS
K POP,ZTRTN,ZTSAVE,ZTDESC,PG,TOTS,TOTU,PDATE,PJ,DTT,INST,SSN,P,ERR
K DTI,TRIES,FLAG,DTL,EDATE1,EDATE2,NAME,%,MCNOW,MCDAY,MCTIME,%I,D,DASH,I,Y,Z
I $D(ZTQUEUED)#2 D KILL^%ZTLOAD K ZTSK
W @IOF D ^%ZISC G ^MCARAP:$D(REDO)
Q
PAGE ; New screen control
K EXIT I $Y>(IOSL-7),($E(IOST,1,2)="C-") R !!,"Press return to continue: '^' to escape: ",X:DTIME G:'$T EXIT S:X=U EXIT=1 Q:$D(EXIT) D HEAD
I $Y=(IOSL-1),(IOST?1"P-".E) D HEAD
Q
STAT ; Statistical totals
I $D(NAME),(NAME'=$P(^MCAR(700.5,ENTRY,0),U,4)) Q
I $P(^MCAR(700.5,ENTRY,0),U,5)="" S TOTS=TOTS+1 Q
S TOTU=TOTU+1 Q
WSTAT W !!
W:$D(NAME) "For Patient ",NAME,":",!
I $D(GOOD),(TOTS>0) W "Successful: ",TOTS," "
I $D(BAD),(TOTU>0) W "Unsuccessful: ",TOTU," "
I $D(ALL),(TOTS>0!(TOTU>0)) W "Successful: ",TOTS," Unsuccessful: ",TOTU," Total Attempts: ",(TOTS+TOTU)
I $D(GOOD),(TOTS=0) W "** No Successful Record transfers completed **"
I $D(BAD),(TOTU=0) W "** No Unsuccessful Record Transfer attempts made **"
I $D(ALL),(TOTS=0&(TOTU=0)) W "** No Record Transfer attempts made **"
Q
STYPE ; Screen Summary Type
S ENTRY=0 S ENTRY=$O(^MCAR(700.5,"C",PDATE,ENTRY)) Q:ENTRY=""
I $D(MCARA) S:MCARA=$P(^MCAR(700.5,ENTRY,0),U,10) TYPE=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMCARAP1 3354 printed Dec 13, 2024@02:12:17 Page 2
MCARAP1 ;WASH ISC/SAE-MEDICINE AUTO INSTRUMENT INTERFACE SUMMARY PRINT ;5/7/96 13:43
+1 ;;2.3;Medicine;;09/13/1996
+2 ;
PRINT ; Print Report
+1 SET PG=0
SET (TOTS,TOTU)=0
KILL REDO
+2 DO NOW^%DTC
SET Y=%
DO DD^%DT
SET MCNOW=$EXTRACT(Y,1,18)
SET MCDAY=$EXTRACT(Y,1,12)
SET MCTIME=$EXTRACT(Y,13,18)
+3 DO HEAD
+4 SET PDATE=DATE1
DO PRINT1
FOR PJ=0:0
SET PDATE=$ORDER(^MCAR(700.5,"C",PDATE))
if PDATE=""
DO WSTAT
if $PIECE(PDATE,".")>DATE2
DO WSTAT
if PDATE=""
GOTO EXIT
if $PIECE(PDATE,".")>DATE2
GOTO EXIT
DO STYPE
IF $DATA(TYPE)
KILL TYPE
DO PRINT1
if $DATA(EXIT)
GOTO EXIT1
+5 QUIT
PRINT1 SET ENTRY=0
FOR IJ=0:0
SET ENTRY=$ORDER(^MCAR(700.5,"C",PDATE,ENTRY))
if ENTRY=""
QUIT
DO STAT
DO PAGE
if $DATA(EXIT)
QUIT
DO WRITE
+1 QUIT
WRITE ; Write report line
+1 IF $DATA(NAME)
IF (NAME'=$PIECE(^MCAR(700.5,ENTRY,0),U,4))
QUIT
+2 IF $DATA(BAD)
IF ($PIECE(^MCAR(700.5,ENTRY,0),U,8)="S")
QUIT
+3 IF $DATA(GOOD)
IF ($PIECE(^MCAR(700.5,ENTRY,0),U,8)="U")
QUIT
+4 SET DTT=$PIECE(^MCAR(700.5,ENTRY,0),U)
SET INST=$PIECE(^(0),U,2)
SET SSN=$PIECE(^(0),U,3)
SET P=$PIECE(^(0),U,4)
SET ERR=$PIECE(^(0),U,5)
SET DTI=$PIECE(^(0),U,6)
SET TRIES=$PIECE(^(0),U,7)
SET FLAG=$PIECE(^(0),U,8)
SET DTL=$PIECE(^(0),U,9)
+5 SET Y=DTT
DO DD^%DT
SET DTT=Y
SET Y=DTI
DO DD^%DT
SET DTI=$EXTRACT(Y,1,18)
SET Y=DTL
DO DD^%DT
SET DTL=$EXTRACT(Y,1,18)
+6 WRITE !,$PIECE(DTT,"@"),?14,DTI,?34,P,?60,SSN,?71,TRIES,?76,ERR,!,?6,$EXTRACT(DTT,13,18),?14,DTL
+7 QUIT
HEAD ; Header
+1 SET PG=PG+1
WRITE @IOF,!,?18,"VETERANS ADMINISTRATION MEDICAL CENTER",?72,"Page ",PG
+2 ;W !,?28,^DD("SITE"),?66,MCDAY
+3 WRITE !,?28,$$GET1^DIQ(4.3,1,217),?66,MCDAY
+4 if $DATA(GOOD)
WRITE !,?14,"SUMMARY OF SUCCESSFUL RECORD TRANSFER ATTEMPTS",?72,MCTIME
+5 if $DATA(BAD)
WRITE !,?13,"SUMMARY OF UNSUCCESSFUL RECORD TRANSFER ATTEMPTS",?72,MCTIME
+6 if $DATA(ALL)
WRITE !,?17,"SUMMARY OF ALL RECORD TRANSFER ATTEMPTS",?72,MCTIME
+7 KILL DATESAME
if DATE1=DATE2
SET DATESAME=1
+8 if $DATA(DATESAME)
WRITE !,?24
if '$DATA(DATESAME)
WRITE !,?19
WRITE "DHCP ("
+9 SET Y=DATE1
DO DD^%DT
SET EDATE1=Y
SET Y=DATE2
DO DD^%DT
SET EDATE2=Y
+10 if $DATA(DATESAME)
WRITE EDATE1,")"
if '$DATA(DATESAME)
WRITE EDATE1," - ",EDATE2,")"
+11 WRITE !!,"TEST DATE",?17,"FIRST TRANS",?37,"PATIENT",?63,"SSN",?69,"TRIES",?76,"ERR",!,"TEST TIME",?17,"LAST TRANS"
+12 SET DASH=""
SET $PIECE(DASH,"-",80)=""
WRITE !,DASH
+13 QUIT
EXIT ; Exit from program
+1 IF IOST'?1"P-".E
READ !!,"Press return to continue, or '^' to escape: ",X:DTIME
+2 if '$TEST
GOTO EXIT1
if X=U
GOTO EXIT1
GOTO ^MCARAP
EXIT1 KILL GOOD,BAD,ALL,J,DIK,ENTRY,DATE1,DATE2,IJ,PG,RPT,DA,%,%DT,ZIP,%ZIS
+1 KILL POP,ZTRTN,ZTSAVE,ZTDESC,PG,TOTS,TOTU,PDATE,PJ,DTT,INST,SSN,P,ERR
+2 KILL DTI,TRIES,FLAG,DTL,EDATE1,EDATE2,NAME,%,MCNOW,MCDAY,MCTIME,%I,D,DASH,I,Y,Z
+3 IF $DATA(ZTQUEUED)#2
DO KILL^%ZTLOAD
KILL ZTSK
+4 WRITE @IOF
DO ^%ZISC
if $DATA(REDO)
GOTO ^MCARAP
+5 QUIT
PAGE ; New screen control
+1 KILL EXIT
IF $Y>(IOSL-7)
IF ($EXTRACT(IOST,1,2)="C-")
READ !!,"Press return to continue: '^' to escape: ",X:DTIME
if '$TEST
GOTO EXIT
if X=U
SET EXIT=1
if $DATA(EXIT)
QUIT
DO HEAD
+2 IF $Y=(IOSL-1)
IF (IOST?1"P-".E)
DO HEAD
+3 QUIT
STAT ; Statistical totals
+1 IF $DATA(NAME)
IF (NAME'=$PIECE(^MCAR(700.5,ENTRY,0),U,4))
QUIT
Press return to continue: +2 IF $PIECE(^MCAR(700.5,ENTRY,0),U,5)=""
SET TOTS=TOTS+1
QUIT
+3 SET TOTU=TOTU+1
QUIT
WSTAT WRITE !!
+1 if $DATA(NAME)
WRITE "For Patient ",NAME,":",!
+2 IF $DATA(GOOD)
IF (TOTS>0)
WRITE "Successful: ",TOTS," "
+3 IF $DATA(BAD)
IF (TOTU>0)
WRITE "Unsuccessful: ",TOTU," "
+4 IF $DATA(ALL)
IF (TOTS>0!(TOTU>0))
WRITE "Successful: ",TOTS," Unsuccessful: ",TOTU," Total Attempts: ",(TOTS+TOTU)
+5 IF $DATA(GOOD)
IF (TOTS=0)
WRITE "** No Successful Record transfers completed **"
+6 IF $DATA(BAD)
IF (TOTU=0)
WRITE "** No Unsuccessful Record Transfer attempts made **"
+7 IF $DATA(ALL)
IF (TOTS=0&(TOTU=0))
WRITE "** No Record Transfer attempts made **"
+8 QUIT
STYPE ; Screen Summary Type
+1 SET ENTRY=0
SET ENTRY=$ORDER(^MCAR(700.5,"C",PDATE,ENTRY))
if ENTRY=""
QUIT
+2 IF $DATA(MCARA)
if MCARA=$PIECE(^MCAR(700.5,ENTRY,0),U,10)
SET TYPE=1
+3 QUIT
