- 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 Feb 18, 2025@23:38:45 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
- +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 Press return to continue: 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