source: FOIAVistA/trunk/r/WOMENS_HEALTH-WV/WVBRPCD.m@ 685

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