source: FOIAVistA/trunk/r/WOMENS_HEALTH-WV/WVPROF.m

WVPROF ;HCIOFO/FT,JR IHS/ANMC/MWR - DISPLAY PATIENT PROFILE; ;7/30/98  11:38
 ;;1.0;WOMEN'S HEALTH;;Sep 30, 1998
 ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
 ;;  CALL ED BY OPTION: "WV PATIENT PROFILE" TO DISPLAY PROFILE.
 ;
 ;---> *NOTE: TO ASK DATE RANGE, UNCOMMENT ALL LINES WITH "XDATES",
 ;--->        AND IN HEADER2^WVUTL7.
 ;
 ;---> VARIABLES:
 ;---> WVDFN: DFN OF SELECTED PATIENT
 ;---> DATES: WVBEGDT=BEGINNING DATE, WVENDDT=ENDING DATE
 ;---> USE NODES 1 & 2 IN ^TMP GLOBAL.
 ;
 D SETVARS^WVUTL5
 S:'$D(WVERRORS) WVERRORS=1
 F  D RUN Q:WVPOP
 D EXIT
 Q
 ;
RUN ;EP
 D TITLE^WVUTL5("PATIENT PROFILE")
 D PATIENT Q:WVPOP
 D BRIEF   Q:WVPOP
 D DEVICE  Q:WVPOP
 D SORT^WVPROF2
 D COPYGBL
 D ^WVPROF1 S WVPOP=0
 K WVD,WVSUBH
 Q
 ;
EXIT ;EP
 D KILLALL^WVUTL8
 Q
 ;
 ;
PATIENT ;EP
 ;---> SELECT PATIENT (RETURN WVDFN).
 W !!,"   Select the patient whose Profile you wish to display."
 D PATLKUP^WVUTL8(.Y) S:Y<0 WVPOP=1
 ;---> USE NEXT LINE IF I WANT TO ADD CAPABILITY OF ADDING NEW PATIENT.
 ;D PATLKUP^WVUTL8(.Y,$S($G(WVPUSER):"",1:"ADD")) S:Y<0 WVPOP=1
 S WVDFN=+Y
 Q
 ;
DATES ;EP
 ;---> ASK DATE RANGE.  RETURN DATES IN WVBEGDT AND WVENDDT.
 ;---> IF LOOKING AT ONLY ONE PATIENT, SET DEFAULT BEGIN DATE=T-5YEARS.
 ;S WVBEGDT=2500101,WVENDDT=DT     ;---> XDATES-CAN USE THIS INSTEAD.
 ;S WVBEGDF="T-60M",WVENDDF="T"    ;---> XDATES
 ;D ASKDATES^WVUTL3(.WVBEGDT,.WVENDDT,.WVPOP,"T-365","T")  ;---> XDATES
 Q
 ;
BRIEF ;EP
 ;---> BRIEF OR DETAILED LISTING OF PROCEDURES (BRIEF DOES NOT LIST
 ;---> NOTIFICATIONS AND PROVIDERS).
 N DIR,DIRUT,Y
 W !!?3,"List Patient Profile in BRIEF or DETAILED format?"
 S DIR("A")="   Select BRIEF or DETAILED: ",DIR("B")="BRIEF"
 S DIR(0)="SAM^b:BRIEF;d:DETAILED" D HELP1
 D ^DIR
 I Y=-1!($D(DIRUT)) S WVPOP=1 Q
 ;---> IF ALL DETAILED, S WVD=1; FOR BRIEF WVD=0
 S WVD=$S(Y="d":1,1:0)
 Q
 ;
DEVICE ;EP
 ;---> GET DEVICE AND POSSIBLY QUEUE TO TASKMAN.
 S ZTRTN="DEQUEUE^WVPROF"
 F WVSV="D","DFN","BEGDT","ENDDT","ERRORS" D
 .I $D(@("WV"_WVSV)) S ZTSAVE("WV"_WVSV)=""
 D ZIS^WVUTL2(.WVPOP,1,"HOME")
 Q
 ;
COPYGBL ;EP
 ;---> 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
 ;---> EP FOR TASKMAN QUEUE OF PRINTOUT.
 D SETVARS^WVUTL5,SORT^WVPROF2,COPYGBL,^WVPROF1,EXIT
 Q
 ;
HELP1 ;EP
 ;;Enter "D" for a "Detailed" listing of the patient's Procedures,
 ;;Notifications, PAP Regimen and Pregnancy changes.
 ;;Enter "B" for a "Brief" listing of the patient's Procedures only.
 S WVTAB=5,WVLINL="HELP1" D HELPTX
 Q
 ;
HELPTX ;EP
 ;---> CREATES DIR ARRAY FOR DIR.  REQUIRED VARIABLES: WVTAB,WVLINL.
 N I,T,X S T=$$REPEAT^XLFSTR(" ",WVTAB)
 F I=1:1 S X=$T(@WVLINL+I) Q:X'[";;"  S DIR("?",I)=T_$P(X,";;",2)
 S DIR("?")=DIR("?",I-1) K DIR("?",I-1)
 Q
 ;
 ;
USER ;EP
 ;---> CALLED BY OPTION: "WV PATIENT PROFILE USER"
 ;---> FOR USER TO VIEW PROFILE AND PRINT PROCEDURES, BUT NO EDIT.
 S WVPUSER=1
 D WVPROF K WVPUSER
 Q
 ;
ERRORS ;EP
 ;---> CALLED BY OPTION: "WV PATIENT PROFILE W/ERRORS"
 ;---> ENTER HERE TO INCLUDE ERRONEOUS ENTRIES.
 S WVERRORS=0 G WVPROF
 Q