Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: WVBRPCD

WVBRPCD.m

Go to the documentation of this file. 
  1. WVBRPCD ;HCIOFO/FT,JR IHS/ANMC/MWR - BROWSE PROCEDURES; ;7/30/98  11:07
  1.  ;;1.0;WOMEN'S HEALTH;;Sep 30, 1998
  1.  ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
  1.  ;;  CALLED BY OPTION: "WV BROWSE PROCEDURES" TO BROWSE AND EDIT
  1.  ;;  PROCEDURES.
  1.  ;
  1.  ;---> VARIABLES:
  1.  ;---> WVA:   1=ALL PATIENTS, 0=ONE PATIENT
  1.  ;---> WVDFN: DFN OF SELECTED PATIENT
  1.  ;---> DATES: WVBEGDT=BEGINNING DATE, WVENDDT=ENDING DATE
  1.  ;---> WVD:   1=BOTH ABNORMAL AND NORMAL, 0=NORMAL ONLY
  1.  ;---> SORT SEQUENCE IN WVC:  1=DATE, PATIENT, PRIORITY
  1.  ;--->                        2=PATIENT, DATE, PRIORITY
  1.  ;--->                        3=PRIORITY, DATE, PATIENT
  1.  ;---> USE NODES 1 & 2 IN ^TMP GLOBAL
  1.  ;
  1.  D SETVARS^WVUTL5 S WVPOP=0
  1.  D ^WVBRPCD2 G:WVPOP EXIT
  1.  D SORT
  1.  D COPYGBL
  1.  ;---> NEXT LINE: PASS TITLE, HEADER (IN ^WVUTL7), AND CODE TO
  1.  ;---> EXECUTE BY DIR AT BOTTOM OF SCREEN.
  1.  D DISPLAY^WVBRPCD1(WVTITLE,WVHEADER,WVCODE)
  1.  ;
  1. EXIT ;EP
  1.  D KILLALL^WVUTL8
  1.  Q
  1.  ;
  1.  ;
  1. SORT ;EP
  1.  ;---> SORT AND STORE ARRAY IN ^TMP("WV",$J
  1.  K ^TMP("WV",$J)
  1.  ;---> WVBEGDT1=ONE SECOND BEFORE BEGIN DATE.
  1.  ;---> WVENDDT1=THE LAST SECOND OF END DATE.
  1.  S WVBEGDT1=WVBEGDT-.0001,WVENDDT1=WVENDDT+.9999
  1.  ;
  1.  ;***********************
  1.  ;---> WVA=1 ALL PATIENTS
  1.  I WVA D  Q
  1.  .;---> BY DATE GET EITHER ALL OR ABNORMAL ONLY.
  1.  .;---> ("INSUFFICIENT TISSUE" IS INCLUDED IN ABNML XREF.)
  1.  .S WVXREF=$S(WVD:"D",1:"ABNML")
  1.  .S WVDATE=WVBEGDT1
  1.  .F  S WVDATE=$O(^WV(790.1,WVXREF,WVDATE)) Q:'WVDATE!(WVDATE>WVENDDT1)  D
  1.  ..S WVIEN=0
  1.  ..F  S WVIEN=$O(^WV(790.1,WVXREF,WVDATE,WVIEN)) Q:'WVIEN  D
  1.  ...S Y=^WV(790.1,WVIEN,0),WVDFN=$P(Y,U,2)
  1.  ...;---> QUIT IF THIS PROCEDURE HAS A RESULT OF "ERROR/DISREGARD".
  1.  ...Q:$P(Y,U,5)=8
  1.  ...;---> QUIT IF NOT SELECTING FOR ALL PROCEDURES AND IF THIS IS
  1.  ...;---> NOT ONE OF THE SELECTED PROCEDURES.
  1.  ...I '$D(WVARR("ALL"))  Q:'$D(WVARR($P(Y,U,4)))
  1.  ...;---> QUIT IF NOT "ALL PROCEDURES" AND THIS ENTRY IS "CLOSED".
  1.  ...Q:WVB'="a"&($P(Y,U,14)="c")
  1.  ...;---> QUIT IF SELECTING FOR ONE CASE MANAGER AND THIS DOESN'T MATCH.
  1.  ...I 'WVE Q:$P(^WV(790,WVDFN,0),U,10)'=WVCMGR
  1.  ...;---> QUIT IF LISTING "DELINQUENT" AND THIS PROCDURE IS NOT DELINQ.
  1.  ...I WVB="d" Q:$P(Y,U,13)>DT!($P(Y,U,13)="")
  1.  ...;---> QUIT IF LISTING "NEW" AND THIS PROCDURE IS NOT NEW.
  1.  ...;Q:WVB="n"&($P(Y,U,14)'="n")
  1.  ...D STORE(WVC,WVIEN,Y)
  1.  ;
  1.  ;**********************
  1.  ;---> WVA=0 ONE PATIENT
  1.  S WVIEN=0
  1.  F  S WVIEN=$O(^WV(790.1,"C",WVDFN,WVIEN)) Q:'WVIEN  D
  1.  .;---> SET Y=THE ZERO NODE FOR THIS PROCEDURE.
  1.  .S Y=^WV(790.1,WVIEN,0)
  1.  .;---> QUIT IF THIS PROCEDURE HAS A RESULT OF "ERROR/DISREGARD".
  1.  .Q:$P(Y,U,5)=8
  1.  .;---> QUIT IF NOT WITHIN DATE RANGE.
  1.  .S WVDATE=$P(Y,U,12)
  1.  .Q:WVDATE'>WVBEGDT1!(WVDATE>WVENDDT1)
  1.  .;---> QUIT IF SELECTING FOR "ABNORMAL" ONLY AND THIS PROCEDURE
  1.  .;---> "NORMAL". ("INSUFF TISSUE" AND "UNSAT EXAM" WILL BE "ABNORMAL".)
  1.  .Q:'WVD&('$$NORMAL^WVUTL4($P(Y,U,5)))
  1.  .;---> QUIT IF "DELINQUENT" OR "OPEN" ONLY AND THIS ENTRY IS "CLOSED".
  1.  .Q:WVB'="a"&($P(Y,U,14)="c")
  1.  .;---> QUIT IF LISTING "DELINQUENT" AND THIS PROCDURE IS NOT DELINQ.
  1.  .I WVB="d" Q:$P(Y,U,13)>DT!($P(Y,U,13)="")
  1.  .;Q:WVB="n"&($P(Y,U,14)'="n")
  1.  .D STORE(WVC,WVIEN,Y)
  1.  Q
  1.  ;
  1. STORE(WVC,WVIEN,Y) ;EP
  1.  ;---> CALLED TO STORE PROCEDURES IN ^TMP FOR BROWSING.
  1.  ;---> WVC=LIST ORDER, WVIEN=IEN OR PROCEDURE, Y=ZERO NODE OF PROCEDURE.
  1.  S WVDFN=$P(Y,U,2),WVDATE=$P(Y,U,12)                   ;---> DFN, DATE
  1.  S WVCHRT=$$SSN^WVUTL1(WVDFN)_" "                      ;---> SSN#
  1.  S WVNAME=$$NAME^WVUTL1(WVDFN)                         ;---> NAME
  1.  S WVACC=$P(Y,U)                                       ;---> ACCESSION#
  1.  S WVSTAT=$E($$STATUS^WVUTL4)                          ;---> STATUS
  1.  S WVDIAG=$$DIAG^WVUTL4($P(Y,U,5))                     ;---> RESULT/DIAG
  1.  S X=$P(Y,U,5),WVPRIO=$$PRIOR^WVUTL4 K X               ;---> PRIORITY
  1.  ;
  1.  S X=WVCHRT_U_WVNAME_U_WVDATE_U_WVACC_U_WVDIAG_U_WVPRIO_U_WVSTAT_U_WVIEN
  1.  I WVC=1 S ^TMP("WV",$J,1,WVDATE,WVNAME,WVPRIO,WVIEN)=X Q
  1.  I WVC=2 S ^TMP("WV",$J,1,WVNAME,WVDATE,WVPRIO,WVIEN)=X Q
  1.  I WVC=3 S ^TMP("WV",$J,1,WVPRIO,WVDATE,WVNAME,WVIEN)=X
  1.  Q
  1.  ;
  1. COPYGBL ;EP
  1.  ;---> CALLED TO FLATTEN THE ^TMP ARRAY OF PROCEDURES FOR BROWSING.
  1.  ;---> COPY ^TMP("WV",$J,1 TO ^TMP("WV",$J,2 TO MAKE IT FLAT.
  1.  N I,M,N,P,Q
  1.  S N=0,I=0
  1.  F  S N=$O(^TMP("WV",$J,1,N)) Q:N=""  D
  1.  .S M=0
  1.  .F  S M=$O(^TMP("WV",$J,1,N,M)) Q:M=""  D
  1.  ..S P=0
  1.  ..F  S P=$O(^TMP("WV",$J,1,N,M,P)) Q:P=""  D
  1.  ...S Q=0
  1.  ...F  S Q=$O(^TMP("WV",$J,1,N,M,P,Q)) Q:Q=""  D
  1.  ....S I=I+1,^TMP("WV",$J,2,I)=^TMP("WV",$J,1,N,M,P,Q)
  1.  Q
  1.  ;
  1. DEQUEUE ;EP
  1.  ;---> FOR TASKMAN QUEUE OF PRINTOUT.
  1.  D SETVARS^WVUTL5,SORT,COPYGBL
  1.  D DISPLAY^WVBRPCD1(WVTITLE,WVHEADER,WVCODE)
  1.  D EXIT
  1.  Q