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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---WVPROF   3437     printed  Mar 13, 2025@21:52:25                                                                                                                                                                                                      Page 2

WVPROF    ;HCIOFO/FT,JR IHS/ANMC/MWR - DISPLAY PATIENT PROFILE; ;7/30/98  11:38

 +1       ;;1.0;WOMEN'S HEALTH;;Sep 30, 1998

 +2       ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *

 +3       ;;  CALL ED BY OPTION: "WV PATIENT PROFILE" TO DISPLAY PROFILE.

 +4       ;

 +5       ;---> *NOTE: TO ASK DATE RANGE, UNCOMMENT ALL LINES WITH "XDATES",

 +6       ;--->        AND IN HEADER2^WVUTL7.

 +7       ;

 +8       ;---> VARIABLES:

 +9       ;---> WVDFN: DFN OF SELECTED PATIENT

 +10      ;---> DATES: WVBEGDT=BEGINNING DATE, WVENDDT=ENDING DATE

 +11      ;---> USE NODES 1 & 2 IN ^TMP GLOBAL.

 +12      ;

 +13       DO SETVARS^WVUTL5

 +14       if '$DATA(WVERRORS)

               SET WVERRORS=1

 +15       FOR 

               DO RUN

               if WVPOP

                   QUIT 

 +16       DO EXIT

 +17       QUIT 

 +18      ;

RUN       ;EP

 +1        DO TITLE^WVUTL5("PATIENT PROFILE")

 +2        DO PATIENT

           if WVPOP

               QUIT 

 +3        DO BRIEF

           if WVPOP

               QUIT 

 +4        DO DEVICE

           if WVPOP

               QUIT 

 +5        DO SORT^WVPROF2

 +6        DO COPYGBL

 +7        DO ^WVPROF1

           SET WVPOP=0

 +8        KILL WVD,WVSUBH

 +9        QUIT 

 +10      ;

EXIT      ;EP

 +1        DO KILLALL^WVUTL8

 +2        QUIT 

 +3       ;

 +4       ;

PATIENT   ;EP

 +1       ;---> SELECT PATIENT (RETURN WVDFN).

 +2        WRITE !!,"   Select the patient whose Profile you wish to display."

 +3        DO PATLKUP^WVUTL8(.Y)

           if Y<0

               SET WVPOP=1

 +4       ;---> USE NEXT LINE IF I WANT TO ADD CAPABILITY OF ADDING NEW PATIENT.

 +5       ;D PATLKUP^WVUTL8(.Y,$S($G(WVPUSER):"",1:"ADD")) S:Y<0 WVPOP=1

 +6        SET WVDFN=+Y

 +7        QUIT 

 +8       ;

DATES     ;EP

 +1       ;---> ASK DATE RANGE.  RETURN DATES IN WVBEGDT AND WVENDDT.

 +2       ;---> IF LOOKING AT ONLY ONE PATIENT, SET DEFAULT BEGIN DATE=T-5YEARS.

 +3       ;S WVBEGDT=2500101,WVENDDT=DT     ;---> XDATES-CAN USE THIS INSTEAD.

 +4       ;S WVBEGDF="T-60M",WVENDDF="T"    ;---> XDATES

 +5       ;D ASKDATES^WVUTL3(.WVBEGDT,.WVENDDT,.WVPOP,"T-365","T")  ;---> XDATES

 +6        QUIT 

 +7       ;

BRIEF     ;EP

 +1       ;---> BRIEF OR DETAILED LISTING OF PROCEDURES (BRIEF DOES NOT LIST

 +2       ;---> NOTIFICATIONS AND PROVIDERS).

 +3        NEW DIR,DIRUT,Y

 +4        WRITE !!?3,"List Patient Profile in BRIEF or DETAILED format?"

 +5        SET DIR("A")="   Select BRIEF or DETAILED: "

           SET DIR("B")="BRIEF"

 +6        SET DIR(0)="SAM^b:BRIEF;d:DETAILED"

           DO HELP1

 +7        DO ^DIR

 +8        IF Y=-1!($DATA(DIRUT))

               SET WVPOP=1

               QUIT 

 +9       ;---> IF ALL DETAILED, S WVD=1; FOR BRIEF WVD=0

 +10       SET WVD=$SELECT(Y="d":1,1:0)

 +11       QUIT 

 +12      ;

DEVICE    ;EP

 +1       ;---> GET DEVICE AND POSSIBLY QUEUE TO TASKMAN.

 +2        SET ZTRTN="DEQUEUE^WVPROF"

 +3        FOR WVSV="D","DFN","BEGDT","ENDDT","ERRORS"

               Begin DoDot:1

 +4                IF $DATA(@("WV"_WVSV))

                       SET ZTSAVE("WV"_WVSV)=""

               End DoDot:1

 +5        DO ZIS^WVUTL2(.WVPOP,1,"HOME")

 +6        QUIT 

 +7       ;

COPYGBL   ;EP

 +1       ;---> COPY ^TMP("WV",$J,1 TO ^TMP("WV",$J,2 TO MAKE IT FLAT.

 +2        NEW I,M,N,P,Q

 +3        SET N=0

           SET I=0

 +4        FOR 

               SET N=$ORDER(^TMP("WV",$JOB,1,N))

               if N=""

                   QUIT 

               Begin DoDot:1

 +5                SET M=0

 +6                FOR 

                       SET M=$ORDER(^TMP("WV",$JOB,1,N,M))

                       if M=""

                           QUIT 

                       Begin DoDot:2

 +7                        SET P=0

 +8                        FOR 

                               SET P=$ORDER(^TMP("WV",$JOB,1,N,M,P))

                               if P=""

                                   QUIT 

                               Begin DoDot:3

 +9                                SET Q=0

 +10                               FOR 

                                       SET Q=$ORDER(^TMP("WV",$JOB,1,N,M,P,Q))

                                       if Q=""

                                           QUIT 

                                       Begin DoDot:4

 +11                                       SET I=I+1

                                           SET ^TMP("WV",$JOB,2,I)=^TMP("WV",$JOB,1,N,M,P,Q)

                                       End DoDot:4

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +12       QUIT 

 +13      ;

 +14      ;

DEQUEUE   ;EP

 +1       ;---> EP FOR TASKMAN QUEUE OF PRINTOUT.

 +2        DO SETVARS^WVUTL5

           DO SORT^WVPROF2

           DO COPYGBL

           DO ^WVPROF1

           DO EXIT

 +3        QUIT 

 +4       ;

HELP1     ;EP

 +1       ;;Enter "D" for a "Detailed" listing of the patient's Procedures,

 +2       ;;Notifications, PAP Regimen and Pregnancy changes.

 +3       ;;Enter "B" for a "Brief" listing of the patient's Procedures only.

 +4        SET WVTAB=5

           SET WVLINL="HELP1"

           DO HELPTX

 +5        QUIT 

 +6       ;

HELPTX    ;EP

 +1       ;---> CREATES DIR ARRAY FOR DIR.  REQUIRED VARIABLES: WVTAB,WVLINL.

 +2        NEW I,T,X

           SET T=$$REPEAT^XLFSTR(" ",WVTAB)

 +3        FOR I=1:1

               SET X=$TEXT(@WVLINL+I)

               if X'[";;"

                   QUIT 

               SET DIR("?",I)=T_$PIECE(X,";;",2)

 +4        SET DIR("?")=DIR("?",I-1)

           KILL DIR("?",I-1)

 +5        QUIT 

 +6       ;

 +7       ;

USER      ;EP

 +1       ;---> CALLED BY OPTION: "WV PATIENT PROFILE USER"

 +2       ;---> FOR USER TO VIEW PROFILE AND PRINT PROCEDURES, BUT NO EDIT.

 +3        SET WVPUSER=1

 +4        DO WVPROF

           KILL WVPUSER

 +5        QUIT 

 +6       ;

ERRORS    ;EP

 +1       ;---> CALLED BY OPTION: "WV PATIENT PROFILE W/ERRORS"

 +2       ;---> ENTER HERE TO INCLUDE ERRONEOUS ENTRIES.

 +3        SET WVERRORS=0

           GOTO WVPROF

 +4        QUIT