Changeset 636 for FOIAVistA/tag/r/SCHEDULING-SD-SC/SCRPW8.m

Timestamp:

Dec 4, 2009, 8:26:01 PM (16 years ago)

Author:

George Lilly

Message:

WorldVistAEHR overlayed on FOIAVistA

Location:

FOIAVistA/tag/r

Files:

• . (copied) (copied from FOIAVistA/trunk/r )
• SCHEDULING-SD-SC/SCRPW8.m (modified) (6 diffs)

FOIAVistA/tag/r/SCHEDULING-SD-SC/SCRPW8.m

@@ -1 +1 @@
 SCRPW8 ;RENO/KEITH - Outpatient Encounter Workload Statistics ; 04 Feb 99  4:53 PM
- ;;5.3;Scheduling;**139,145,144,176,339,466,510**;AUG 13, 1993;Build 3
+ ;;5.3;Scheduling;**139,145,144,176,339,466**;AUG 13, 1993;Build 2
 QS ;Queue outpatient encounter workload report
  D PARM^SCRPW9 Q
@@ -28 +28 @@
 PRPT ;Print statistics page
  D STOP Q:SDOUT
- S SDCT=0 F SDI=1,2,3,11,14,"8-CC" S SDCT=SDCT+$G(^TMP(SDS1,$J,SDS2,SDI))
+ S SDCT=0 F SDI=1,2,3,11,14,8 S SDCT=SDCT+$G(^TMP(SDS1,$J,SDS2,SDI))
  D XHDR Q:SDOUT  D SHDR("O U T P A T I E N T   E N C O U N T E R   W O R K L O A D") Q:SDOUT  F SDI=11,14,3,1 D LIST(SDI) Q:SDOUT
  I $D(^TMP(SDS1,$J,SDS2,2)) D:$Y>(IOSL-4) XHDR Q:SDOUT  W !?10,"CHECKED OUT" S SDI=0 F  S SDI=$O(^TMP(SDS1,$J,SDS2,2,SDI)) Q:'SDI!SDOUT  S SDSTAT=$O(^TMP(SDS1,$J,SDS2,2,SDI,"")) D COT
- I $D(^TMP(SDS1,$J,SDS2,"8-CC")) D:$Y>(IOSL-4) XHDR Q:SDOUT  W !?10,"INPATIENT APPOINTMENT" S SDI=0 F  S SDI=$O(^TMP(SDS1,$J,SDS2,"8-CC",SDI)) Q:'SDI!SDOUT  S SDSTAT=$O(^TMP(SDS1,$J,SDS2,"8-CC",SDI,"")) D IAP
- D TOT S (SDI,SDCT)=0 F SDI=4,5,6,7,"8-NC",9,12,13 S SDCT=SDCT+$G(^TMP(SDS1,$J,SDS2,SDI))
- W !! D SHDR("N O N - W O R K L O A D") Q:SDOUT  F SDI="8-NC",12,4,6,5,7,9,10,13 D LIST(SDI) Q:SDOUT
+ I $D(^TMP(SDS1,$J,SDS2,8)) D:$Y>(IOSL-4) XHDR Q:SDOUT  W !?10,"INPATIENT APPOINTMENT" S SDI=0 F  S SDI=$O(^TMP(SDS1,$J,SDS2,8,SDI)) Q:'SDI!SDOUT  S SDSTAT=$O(^TMP(SDS1,$J,SDS2,8,SDI,"")) D IAP
+ D TOT S (SDI,SDCT)=0 F SDI=4,5,6,7,9,12,13 S SDCT=SDCT+$G(^TMP(SDS1,$J,SDS2,SDI))
+ W !! D SHDR("N O N - W O R K L O A D") Q:SDOUT  F SDI=12,4,6,5,7,9,10,13 D LIST(SDI) Q:SDOUT
  D TOT W !! D SHDR(($$HD2()_"   O U T P A T I E N T   V I S I T S")) Q:SDOUT  S SDCT=^TMP(SDS1,$J,SDS2,"VISIT","NWK")+^TMP(SDS1,$J,SDS2,"VISIT","OWK")
  D:$Y>(IOSL-4) XHDR Q:SDOUT  W !?10,"Act. Req./not accepted visits",?47,$J(^TMP(SDS1,$J,SDS2,"VISIT","NWK"),12),?62,$J($S(SDCT=0:0,1:(^TMP(SDS1,$J,SDS2,"VISIT","NWK")*100/SDCT)),8,2)
@@ -52 +52 @@
 EXIT K SDTOE0,SDUNCO,SDUNAR,SDCT,DFN,SDDT,SDDTF,SDDTL,SDDTPF,SDDTPL,SDI,SDLINE,SDOE,SDOE0,SDPNOW,SDSTAT,SDSTX,SDTOE,SDTOEE,SDTOE1,SDTX,SDTXS,SDX,SDZ,DTOUT,X,Y,ZTDESC,ZTRTN,ZTSAVE
  D KVA^VADPT K X1,X2,SDH,SDHL,SDPNAM,SDSSN,SDPAGE,SDPT0,SDUL,DUOUT,SDARCT,SDST,SDPNOW,SDMD,SDMC,SDDIV,SDDNAM,SDS1,SDS2,SDCG,SDCLGR F I="SCRPW","SCRPWD","SCRPWC" K ^TMP(I,$J)
- K I,SDFF,SDOUT,SDSTOP,SDNCOU D END^SCRPW50 Q
+ K I,SDFF,SDOUT,SDSTOP D END^SCRPW50 Q
  ;
 HD1() ;Report subheader 1
@@ -83 +83 @@
  ;
 LIST(SDI) Q:'$D(^TMP(SDS1,$J,SDS2,SDI))  D:$Y>(IOSL-4) XHDR Q:SDOUT
- W !?10,$P(^SD(409.63,+SDI,0),U),?47,$J(^TMP(SDS1,$J,SDS2,SDI),12),?62,$J($S(SDCT=0:0,1:(^TMP(SDS1,$J,SDS2,SDI)*100/SDCT)),8,2)
+ W !?10,$P(^SD(409.63,SDI,0),U),?47,$J(^TMP(SDS1,$J,SDS2,SDI),12),?62,$J($S(SDCT=0:0,1:(^TMP(SDS1,$J,SDS2,SDI)*100/SDCT)),8,2)
  Q
  ;
 COT D:$Y>(IOSL-4) XHDR Q:SDOUT  W !?15,SDSTAT,?47,$J(^TMP(SDS1,$J,SDS2,2,SDI,SDSTAT),12),?62,$J($S(SDCT=0:0,1:(^TMP(SDS1,$J,SDS2,2,SDI,SDSTAT)*100/SDCT)),8,2) Q
  ;
-IAP D:$Y>(IOSL-4) XHDR Q:SDOUT  W !?15,SDSTAT,?47,$J(^TMP(SDS1,$J,SDS2,"8-CC",SDI,SDSTAT),12),?62,$J($S(SDCT=0:0,1:(^TMP(SDS1,$J,SDS2,"8-CC",SDI,SDSTAT)*100/SDCT)),8,2) Q
+IAP D:$Y>(IOSL-4) XHDR Q:SDOUT  W !?15,SDSTAT,?47,$J(^TMP(SDS1,$J,SDS2,8,SDI,SDSTAT),12),?62,$J($S(SDCT=0:0,1:(^TMP(SDS1,$J,SDS2,8,SDI,SDSTAT)*100/SDCT)),8,2) Q
 STOP ;Check for stop task request
  S:$G(ZTQUEUED) (SDOUT,ZTSTOP)=$S($$S^%ZTLOAD:1,1:0) Q
  ;
 COUNT ;Count encounters
- S SDNCOU=$P($G(^SC(+$P(SDOE0,U,4),0)),U,17),SDNCOU=$S(SDNCOU="Y":1,1:0)
  S SDSTOP=SDSTOP+1 I SDSTOP#3000=0 D STOP Q:SDOUT
  D C1("SCRPW",SDDNAM) D:SDMD C1("SCRPWD",SDDIV) D:SDCLGR C1("SCRPWC",SDCG) Q
@@ -99 +98 @@
 C1(SDS1,SDS2) ;Set ^TMP global
  ;Required input: SDS1,SDS2=subscript values
- ;Because there is only 1 status (8) for INPATIENTS, 8-NC is used to
- ;distinguish the non-count clinics from the count clinics, 8-CC.
- S DFN=$P(SDOE0,U,2),SDSTAT=+$P(SDOE0,U,12) I SDSTAT=8 S SDSTAT=$S(SDNCOU:SDSTAT_"-NC",1:SDSTAT_"-CC")
- I SDZ(0),SDZ(4)=SDDIV,SDS1="SCRPW" D DETAIL
+ S DFN=$P(SDOE0,U,2),SDSTAT=+$P(SDOE0,U,12) I SDZ(0),SDZ(4)=SDDIV,SDS1="SCRPW" D DETAIL
  S ^TMP(SDS1,$J,SDS2,SDSTAT)=$G(^TMP(SDS1,$J,SDS2,SDSTAT))+1
- Q:SDSTAT=4  Q:(+SDSTAT=8)&($P(SDSTAT,"-",2)="NC")  D:"114238"[+SDSTAT VIS Q
+ Q:SDSTAT=4  D:"114238"[SDSTAT VIS Q
  ;
-VIS S ^TMP(SDS1,$J,SDS2,"VISIT",$S(SDSTAT=2:"OWK",(+SDSTAT=8)&('SDNCOU):"OWK",1:"NWK"),DFN,$P(SDDT,"."))="" Q:(+SDSTAT'=2)&(+SDSTAT'=8)
- I +SDSTAT=8,$P(SDOE0,U,7)="" D  Q
- .S ^TMP(SDS1,$J,SDS2,SDSTAT,10,"Action Required")=$G(^TMP(SDS1,$J,SDS2,SDSTAT,10,"Action Required"))+1
+VIS S ^TMP(SDS1,$J,SDS2,"VISIT",$S(SDSTAT=2:"OWK",SDSTAT=8:"OWK",1:"NWK"),DFN,$P(SDDT,"."))="" Q:(SDSTAT'=2)&(SDSTAT'=8)
  S SDSTX=$$STX(SDOE,SDOE0),^TMP(SDS1,$J,SDS2,SDSTAT,$P(SDSTX,U),$P(SDSTX,U,2))=$G(^TMP(SDS1,$J,SDS2,SDSTAT,$P(SDSTX,U),$P(SDSTX,U,2)))+1
  Q:$P(SDSTX,U)'=8  S ^TMP(SDS1,$J,SDS2,"VISIT","ACC",DFN,$P(SDDT,"."))=""
@@ -129 +123 @@
  ;
 DETAIL ;Set global for detailed list
- N SDIF S SDIF=0
  D ^VADPT S SDPNAM=VADM(1),SDSSN=$P(VADM(2),U)
- I SDZ(1)="U",+SDSTAT'=4,'SDNCOU S:"114238"[+SDSTAT ^TMP(SDS1,$J,SDS2,"DETAIL",SDPNAM,DFN,SDSSN)="" Q
- I SDZ(1)="V",+SDSTAT'=4,'SDNCOU S:"114238"[+SDSTAT ^TMP(SDS1,$J,SDS2,"DETAIL",SDPNAM,DFN,SDSSN,$P(SDDT,"."))="" Q
+ I SDZ(1)="U",SDSTAT'=4 S:"114238"[SDSTAT ^TMP(SDS1,$J,SDS2,"DETAIL",SDPNAM,DFN,SDSSN)="" Q
+ I SDZ(1)="V",SDSTAT'=4 S:"114238"[SDSTAT ^TMP(SDS1,$J,SDS2,"DETAIL",SDPNAM,DFN,SDSSN,$P(SDDT,"."))="" Q
  Q:'$D(SDZ(2))  ; SD*5.3*339
- I SDZ(2)'=2,SDZ(2)=+SDSTAT D  I SDIF Q
- .I (SDZ(2)=8) Q:$P(SDSTAT,"-",2)="CC"  I SDZ(3)'=9 S SDIF=1 Q
- .D DSET S SDIF=1
- Q:("28"'[SDZ(2))!("28"'[+SDSTAT)  Q:SDZ(2)'=+SDSTAT  D  I SDIF Q
- .I +SDSTAT=8,$P(SDSTAT,"-",2)="NC" S SDIF=1 Q
- .I 'SDZ(3) D DSET S SDIF=1
+ I (SDZ(2)'=2)&(SDZ(2)'=8),SDZ(2)=SDSTAT D DSET Q
+ Q:("28"'[SDZ(2))!("28"'[SDSTAT)!(SDZ(2)'=SDSTAT)  I 'SDZ(3) D DSET Q
  D:+$$STX(SDOE,SDOE0)=SDZ(3) DSET Q
  ;