- MCARAP ;WASH ISC/SAE-MEDICINE AUTO INSTRUMENT INTERFACE SUMMARY PRINT ;5/7/96 09:40
- ;;2.3;Medicine;**16**;09/13/1996
- ;
- D NOW^%DTC S Y=% D DD^%DT S MCDAY=$E(Y,1,12),MCTIME=$E(Y,13,18)
- K GOOD,BAD,J,DIC,ENTRY,DATE1,DATE2,PDATE,IJ,ZIP,REDO,NAME,ALL
- W @IOF,?17,"MEDICINE AUTO INSTRUMENT SUMMARY OF RECORDS TRANSFER"
- W !!!!,?5,"S",?10,"SUCCESSFUL RECORD TRANSFERS"
- W !!,?5,"U",?10,"UNSUCCESSFUL RECORD TRANSFERRAL ATTEMPTS"
- W !!,?5,"A",?10,"ALL RECORD TRANSFERRAL ATTEMPTS"
- ASK R !!!,"Enter selection(S,U,A), '?' for help, or return to escape: ",RPT:DTIME
- G EXIT1^MCARAP1:'$T,EXIT1^MCARAP1:RPT="" K GOOD,BAD,ALL
- I RPT="S" S GOOD=1 K BAD G NAME
- I RPT="U" S BAD=1 K GOOD G NAME
- I RPT="A" S ALL=1 K GOOD,BAD G NAME
- I RPT="?" D QMARK^MCARAP2
- I RPT="?" D PROMPT G EXIT1^MCARAP1:'$T,EXIT1^MCARAP1:ZIP=U D QMARK2^MCARAP2,PROMPT G EXIT1^MCARAP1:'$T,EXIT1^MCARAP1:ZIP=U,MCARAP
- I RPT=U!(RPT="") G EXIT1^MCARAP1
- G MCARAP
- PROMPT R !!,"Press return to continue, or '^' to escape: ",ZIP:DTIME Q
- UPDATE ; Kill all nodes for entries more than 1 month old
- D NOW^%DTC S X1=%
- W @IOF,!,?14,"MEDICINE AUTO INSTRUMENT SUMMARY OF RECORDS TRANSFER"
- W !!!,?14,"Enter the number of days of reports you wish to retain"
- W !,?14,"(30 day minimum), or return to escape: ",*7 R PERIOD:DTIME G:'$T!(PERIOD=U)!(PERIOD="") EXIT1^MCARAP1 G:PERIOD<30 UPDATE
- S X2=-PERIOD D C^%DTC S EXDAY=X ; B
- S PDATE=0 F IJ=1:1 S PDATE=$O(^MCAR(700.5,"C",PDATE)) Q:PDATE="" Q:PDATE>EXDAY D STYPE^MCARAP1 I $D(TYPE) K TYPE S ENT="",ENTRY(IJ)=$O(^MCAR(700.5,"C",PDATE,ENT))
- F IJ=1:1 Q:'$D(ENTRY(IJ)) S DIK="^MCAR(700.5,",DA=ENTRY(IJ) D ^DIK
- K MCARA,EXDAY,IJ,DIK,ENT,ENTRY,PDATE,PERIOD Q
- NAME R !!,"Enter Patient Name (if single Patient search), or '^' to escape: ",NAME:DTIME
- I '$T K NAME G EXIT^MCARAP1
- I NAME=U K NAME G EXIT1^MCARAP1
- I NAME="?" W !,"Enter name (examples: SM/SMITH/SMITH,BILL/SMITH,BILL M)",!,"...or press return to search all Patients)" G NAME
- I NAME?1." ".E W !,"Leading spaces not acceptable",*7 G NAME
- I '$D(NAME)!(NAME="") K NAME G DATE1
- S:NAME[", " NAME=$P(NAME,",")_","_$P(NAME,", ",2) S:NAME[" " NAME=$P(NAME," ")_" "_$P(NAME," ",2)
- S NAMEE=$E(NAME,1,($L(NAME)-1))_$C($A($E(NAME,$L(NAME)))-1)_"ZZZ"
- K ^TMP($J,"MCARA")
- F J=1:1 S NAMEE=$O(^MCAR(700.5,"PT",NAMEE)) Q:NAMEE="" Q:NAME'=$E(NAMEE,1,$L(NAME)) S RN=$O(^(NAMEE,0)),^TMP($J,"MCARA",J)=NAMEE_U_$P(^MCAR(700.5,RN,0),U,3)
- G:'$D(^TMP($J,"MCARA")) NAME2
- W ! F J=1:1 Q:'$D(^TMP($J,"MCARA",J)) W !,?5,J,?10,$P(^(J),U),?40,$P(^(J),U,2)
- NAME1 R !!,"Enter Number: ",ZIP:DTIME G EXIT1^MCARAP1:'$T,EXIT1^MCARAP1:ZIP=U
- I ZIP="" W !!,"No Individual Patient selected",*7 K NAME G NAME
- I ZIP="?" W !,"Enter Number to select Patient, press return to continue, or enter ^ to exit" G NAME1
- I '$D(^TMP($J,"MCARA",ZIP)) W !,"No Individual Patient selected",*7 G NAME1
- S NAME=$P(^TMP($J,"MCARA",ZIP),U)
- G DATE1
- NAME2 W !,"No Entries found in Summary File",*7 G NAME
- DATE1 ; Enter starting date of range of dates for report
- W !! K DTOUT S %DT="AEXPT",%DT("A")="Enter Starting Date: ",%DT("B")="TODAY",%DT(0)="-NOW"
- D ^%DT I X="" K %DT(0) Q
- G:$D(DTOUT) MCARAP G:X=U EXIT1^MCARAP1
- I Y=-1 W *7 R !!,"Invalid date, press return to continue, or ^ to exit: ",ZIP:DTIME G EXIT1^MCARAP1:'$T,EXIT1^MCARAP1:ZIP=U W ! G DATE1
- S DATE1=Y
- DATE2 K DTOUT S %DT="AEXPT",%DT("A")="Enter Ending Date: ",%DT("B")="TODAY",%DT(0)="-NOW"
- D ^%DT I X="" K %DT(0) Q
- G:$D(DTOUT) MCARAP G:X=U EXIT1^MCARAP1
- I Y=-1 W *7 R !!,"Invalid date, press return to continue, or ^ to exit: ",ZIP:DTIME G EXIT1^MCARAP1:'$T,EXIT1^MCARAP1:ZIP=U W ! G DATE2
- S DATE2=Y I DATE2<DATE1 W *7 R !!,"Starting date must precede or equal ending date",!,"Press return to continue, or ^ to exit: ",ZIP:DTIME G EXIT1^MCARAP1:'$T,EXIT1^MCARAP1:ZIP=U W ! G DATE1
- DEVICE ; Select Device
- K IO("Q") S %ZIS="Q" D ^%ZIS G EXIT1^MCARAP1:POP
- QUE ; Perform queueing if selected
- I $D(IO("Q")) S ZTRTN="^MCARAP1",ZTSAVE("DATE*")="",ZTDESC="Medicine Auto Instrument Interface Summary Report" S:$D(GOOD) ZTSAVE("GOOD")="" S:$D(BAD) ZTSAVE("BAD")="" S:$D(NAME) ZTSAVE("NAME")="" S REDO=1
- I $D(IO("Q")) S:$D(MCARA) ZTSAVE("MCARA")=MCARA S:$D(ALL) ZTSAVE("ALL")="" D ^%ZTLOAD K ZTSK,IO("Q") G EXIT1^MCARAP1
- U IO
- G ^MCARAP1
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMCARAP 4280 printed Feb 18, 2025@23:38:44 Page 2
- MCARAP ;WASH ISC/SAE-MEDICINE AUTO INSTRUMENT INTERFACE SUMMARY PRINT ;5/7/96 09:40
- +1 ;;2.3;Medicine;**16**;09/13/1996
- +2 ;
- +3 DO NOW^%DTC
- SET Y=%
- DO DD^%DT
- SET MCDAY=$EXTRACT(Y,1,12)
- SET MCTIME=$EXTRACT(Y,13,18)
- +4 KILL GOOD,BAD,J,DIC,ENTRY,DATE1,DATE2,PDATE,IJ,ZIP,REDO,NAME,ALL
- +5 WRITE @IOF,?17,"MEDICINE AUTO INSTRUMENT SUMMARY OF RECORDS TRANSFER"
- +6 WRITE !!!!,?5,"S",?10,"SUCCESSFUL RECORD TRANSFERS"
- +7 WRITE !!,?5,"U",?10,"UNSUCCESSFUL RECORD TRANSFERRAL ATTEMPTS"
- +8 WRITE !!,?5,"A",?10,"ALL RECORD TRANSFERRAL ATTEMPTS"
- ASK READ !!!,"Enter selection(S,U,A), '?' for help, or return to escape: ",RPT:DTIME
- +1 if '$TEST
- GOTO EXIT1^MCARAP1
- if RPT=""
- GOTO EXIT1^MCARAP1
- KILL GOOD,BAD,ALL
- +2 IF RPT="S"
- SET GOOD=1
- KILL BAD
- GOTO NAME
- +3 IF RPT="U"
- SET BAD=1
- KILL GOOD
- GOTO NAME
- +4 IF RPT="A"
- SET ALL=1
- KILL GOOD,BAD
- GOTO NAME
- +5 IF RPT="?"
- DO QMARK^MCARAP2
- +6 IF RPT="?"
- DO PROMPT
- if '$TEST
- GOTO EXIT1^MCARAP1
- if ZIP=U
- GOTO EXIT1^MCARAP1
- DO QMARK2^MCARAP2
- DO PROMPT
- if '$TEST
- GOTO EXIT1^MCARAP1
- if ZIP=U
- GOTO EXIT1^MCARAP1
- GOTO MCARAP
- +7 IF RPT=U!(RPT="")
- GOTO EXIT1^MCARAP1
- +8 GOTO MCARAP
- PROMPT READ !!,"Press return to continue, or '^' to escape: ",ZIP:DTIME
- QUIT
- UPDATE ; Kill all nodes for entries more than 1 month old
- +1 DO NOW^%DTC
- SET X1=%
- +2 WRITE @IOF,!,?14,"MEDICINE AUTO INSTRUMENT SUMMARY OF RECORDS TRANSFER"
- +3 WRITE !!!,?14,"Enter the number of days of reports you wish to retain"
- +4 WRITE !,?14,"(30 day minimum), or return to escape: ",*7
- READ PERIOD:DTIME
- if '$TEST!(PERIOD=U)!(PERIOD="")
- GOTO EXIT1^MCARAP1
- if PERIOD<30
- GOTO UPDATE
- +5 ; B
- SET X2=-PERIOD
- DO C^%DTC
- SET EXDAY=X
- +6 SET PDATE=0
- FOR IJ=1:1
- SET PDATE=$ORDER(^MCAR(700.5,"C",PDATE))
- if PDATE=""
- QUIT
- if PDATE>EXDAY
- QUIT
- DO STYPE^MCARAP1
- IF $DATA(TYPE)
- KILL TYPE
- SET ENT=""
- SET ENTRY(IJ)=$ORDER(^MCAR(700.5,"C",PDATE,ENT))
- +7 FOR IJ=1:1
- if '$DATA(ENTRY(IJ))
- QUIT
- SET DIK="^MCAR(700.5,"
- SET DA=ENTRY(IJ)
- DO ^DIK
- +8 KILL MCARA,EXDAY,IJ,DIK,ENT,ENTRY,PDATE,PERIOD
- QUIT
- NAME READ !!,"Enter Patient Name (if single Patient search), or '^' to escape: ",NAME:DTIME
- +1 IF '$TEST
- KILL NAME
- GOTO EXIT^MCARAP1
- +2 IF NAME=U
- KILL NAME
- GOTO EXIT1^MCARAP1
- +3 IF NAME="?"
- WRITE !,"Enter name (examples: SM/SMITH/SMITH,BILL/SMITH,BILL M)",!,"...or press return to search all Patients)"
- GOTO NAME
- +4 IF NAME?1." ".E
- WRITE !,"Leading spaces not acceptable",*7
- GOTO NAME
- +5 IF '$DATA(NAME)!(NAME="")
- KILL NAME
- GOTO DATE1
- +6 if NAME[", "
- SET NAME=$PIECE(NAME,",")_","_$PIECE(NAME,", ",2)
- if NAME[" "
- SET NAME=$PIECE(NAME," ")_" "_$PIECE(NAME," ",2)
- +7 SET NAMEE=$EXTRACT(NAME,1,($LENGTH(NAME)-1))_$CHAR($ASCII($EXTRACT(NAME,$LENGTH(NAME)))-1)_"ZZZ"
- +8 KILL ^TMP($JOB,"MCARA")
- +9 FOR J=1:1
- SET NAMEE=$ORDER(^MCAR(700.5,"PT",NAMEE))
- if NAMEE=""
- QUIT
- if NAME'=$EXTRACT(NAMEE,1,$LENGTH(NAME))
- QUIT
- SET RN=$ORDER(^(NAMEE,0))
- SET ^TMP($JOB,"MCARA",J)=NAMEE_U_$PIECE(^MCAR(700.5,RN,0),U,3)
- +10 if '$DATA(^TMP($JOB,"MCARA"))
- GOTO NAME2
- +11 WRITE !
- FOR J=1:1
- if '$DATA(^TMP($JOB,"MCARA",J))
- QUIT
- WRITE !,?5,J,?10,$PIECE(^(J),U),?40,$PIECE(^(J),U,2)
- NAME1 READ !!,"Enter Number: ",ZIP:DTIME
- if '$TEST
- GOTO EXIT1^MCARAP1
- if ZIP=U
- GOTO EXIT1^MCARAP1
- +1 IF ZIP=""
- WRITE !!,"No Individual Patient selected",*7
- KILL NAME
- GOTO NAME
- +2 IF ZIP="?"
- WRITE !,"Enter Number to select Patient, press return to continue, or enter ^ to exit"
- GOTO NAME1
- +3 IF '$DATA(^TMP($JOB,"MCARA",ZIP))
- WRITE !,"No Individual Patient selected",*7
- GOTO NAME1
- +4 SET NAME=$PIECE(^TMP($JOB,"MCARA",ZIP),U)
- +5 GOTO DATE1
- NAME2 WRITE !,"No Entries found in Summary File",*7
- GOTO NAME
- DATE1 ; Enter starting date of range of dates for report
- +1 WRITE !!
- KILL DTOUT
- SET %DT="AEXPT"
- SET %DT("A")="Enter Starting Date: "
- SET %DT("B")="TODAY"
- SET %DT(0)="-NOW"
- +2 DO ^%DT
- IF X=""
- KILL %DT(0)
- QUIT
- +3 if $DATA(DTOUT)
- GOTO MCARAP
- if X=U
- GOTO EXIT1^MCARAP1
- +4 IF Y=-1
- WRITE *7
- READ !!,"Invalid date, press return to continue, or ^ to exit: ",ZIP:DTIME
- if '$TEST
- GOTO EXIT1^MCARAP1
- if ZIP=U
- GOTO EXIT1^MCARAP1
- WRITE !
- GOTO DATE1
- +5 SET DATE1=Y
- DATE2 KILL DTOUT
- SET %DT="AEXPT"
- SET %DT("A")="Enter Ending Date: "
- SET %DT("B")="TODAY"
- SET %DT(0)="-NOW"
- +1 DO ^%DT
- IF X=""
- KILL %DT(0)
- QUIT
- +2 if $DATA(DTOUT)
- GOTO MCARAP
- if X=U
- GOTO EXIT1^MCARAP1
- +3 IF Y=-1
- WRITE *7
- READ !!,"Invalid date, press return to continue, or ^ to exit: ",ZIP:DTIME
- if '$TEST
- GOTO EXIT1^MCARAP1
- if ZIP=U
- GOTO EXIT1^MCARAP1
- WRITE !
- GOTO DATE2
- +4 SET DATE2=Y
- IF DATE2<DATE1
- WRITE *7
- READ !!,"Starting date must precede or equal ending date",!,"Press return to continue, or ^ to exit: ",ZIP:DTIME
- if '$TEST
- GOTO EXIT1^MCARAP1
- if ZIP=U
- GOTO EXIT1^MCARAP1
- WRITE !
- GOTO DATE1
- DEVICE ; Select Device
- +1 KILL IO("Q")
- SET %ZIS="Q"
- DO ^%ZIS
- if POP
- GOTO EXIT1^MCARAP1
- QUE ; Perform queueing if selected
- +1 IF $DATA(IO("Q"))
- SET ZTRTN="^MCARAP1"
- SET ZTSAVE("DATE*")=""
- SET ZTDESC="Medicine Auto Instrument Interface Summary Report"
- if $DATA(GOOD)
- SET ZTSAVE("GOOD")=""
- if $DATA(BAD)
- SET ZTSAVE("BAD")=""
- if $DATA(NAME)
- SET ZTSAVE("NAME")=""
- SET REDO=1
- +2 IF $DATA(IO("Q"))
- if $DATA(MCARA)
- SET ZTSAVE("MCARA")=MCARA
- if $DATA(ALL)
- SET ZTSAVE("ALL")=""
- DO ^%ZTLOAD
- KILL ZTSK,IO("Q")
- GOTO EXIT1^MCARAP1
- +3 USE IO
- +4 GOTO ^MCARAP1