BWMGRP.m

BWMGRP ;IHS/ANMC/MWR - MANAGER'S PATIENT EDITS ;15-Feb-2003 22:02;PLS

 ;;2.0;WOMEN'S HEALTH;**8**;MAY 16, 1996

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

 ;;  CALLED BY DIFFERENT OPTIONS TO EDIT A PATIENT'S PAP REGIMEN LOG

 ;;  AND PREGNANCY LOG.

 ;

PLOG ;EP

 ;---> CALLED BY OPTION: "BW EDIT PAP REGIMEN LOG".

 D SETVARS^BWUTL5

 N DR,Y

 F  D  Q:$G(Y)<0

 .D TITLE^BWUTL5("EDIT PAP REGIMEN LOG")

 .D PLOGTX W !

 .S A="   Select PATIENT (or Enter a new BEGIN DATE): "

 .D DIC^BWFMAN(9002086.04,"QEMAL",.Y,A)

 .Q:Y<0

 .D NAME("^BWPLOG(",+Y)

 .S DR=".01;.03;.05///NOW;.06////"_DUZ

 .D DIE^BWFMAN(9002086.04,DR,+Y,.BWPOP),DIRZ^BWUTL3

 .S:BWPOP Y=-1

 D EXIT

 Q

 ;

PLOGTX ;EP

 ;;WARNING: If you edit the "BEGIN DATE:" of an entry in the PAP REGIMEN

 ;;         Log, be SURE that another entry with the same "BEGIN DATE:"

 ;;         does not already exist for this patient.

 ;;

 ;;         (Ordinarily, the program checks this and will not allow

 ;;         two separate entries for the same patient on the same

 ;;         "BEGIN DATE:".  But under this option you, as the Manager,

 ;;         have greater edit capability.)

 S BWTAB=5,BWLINL="PLOGTX" D PRINTX

 Q

 ;

 ;

EDC ;EP

 ;---> CALLED BY OPTION: "BW EDIT PREGNANCY LOG".

 D SETVARS^BWUTL5

 N DR,Y

 F  D  Q:$G(Y)<0

 .D TITLE^BWUTL5("EDIT PREGNANCY LOG")

 .S A="   Select PATIENT (or Enter a new DATE): "

 .D DIC^BWFMAN(9002086.05,"QEMAL",.Y,A)

 .Q:Y<0

 .D NAME("^BWEDC(",+Y)

 .S DR=".01;.03;.04;.05///NOW;.06////"_DUZ

 .D DIE^BWFMAN(9002086.05,DR,+Y,.BWPOP)

 .S:BWPOP Y=-1

 D EXIT

 Q

 ;

EXIT ;EP

 W @IOF

 D KILLALL^BWUTL8

 Q

 ;

PRINTX ;EP

 ;---> PRINTS TEXT.

 N I,T,X S T="" F I=1:1:BWTAB S T=T_" "

 F I=1:1 S X=$T(@BWLINL+I) Q:X'[";;"  W !,T,$P(X,";;",2)

 Q

 ;

NAME(DIC,Y) ;EP

 N BWDFN

 S BWDFN=$P(@(DIC_Y_",0)"),U,2)

 W !!?3,$$NAME^BWUTL1(BWDFN),"   ",$$HRCN^BWUTL1(BWDFN),!

 Q

 ;

 ;

NONE ;EP

 S BWTITLE="* There are no PAP Regimen Log entries for this patient. *"

 D CENTERT^BWUTL5(.BWTITLE)

 W !!!!,BWTITLE,!!

 D DIRZ^BWUTL3

 Q

BWMGRP    ;IHS/ANMC/MWR - MANAGER'S PATIENT EDITS ;15-Feb-2003 22:02;PLS

 +1       ;;2.0;WOMEN'S HEALTH;**8**;MAY 16, 1996

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

 +3       ;;  CALLED BY DIFFERENT OPTIONS TO EDIT A PATIENT'S PAP REGIMEN LOG

 +4       ;;  AND PREGNANCY LOG.

 +5       ;

PLOG      ;EP

 +1       ;---> CALLED BY OPTION: "BW EDIT PAP REGIMEN LOG".

 +2        DO SETVARS^BWUTL5

 +3        NEW DR,Y

 +4        FOR 

               Begin DoDot:1

 +5                DO TITLE^BWUTL5("EDIT PAP REGIMEN LOG")

 +6                DO PLOGTX

                   WRITE !

 +7                SET A="   Select PATIENT (or Enter a new BEGIN DATE): "

 +8                DO DIC^BWFMAN(9002086.04,"QEMAL",.Y,A)

 +9                IF Y<0

                       QUIT 

 +10               DO NAME("^BWPLOG(",+Y)

 +11               SET DR=".01;.03;.05///NOW;.06////"_DUZ

 +12               DO DIE^BWFMAN(9002086.04,DR,+Y,.BWPOP)

                   DO DIRZ^BWUTL3

 +13               IF BWPOP

                       SET Y=-1

               End DoDot:1

               IF $GET(Y)<0

                   QUIT 

 +14       DO EXIT

 +15       QUIT 

 +16      ;

PLOGTX    ;EP

 +1       ;;WARNING: If you edit the "BEGIN DATE:" of an entry in the PAP REGIMEN

 +2       ;;         Log, be SURE that another entry with the same "BEGIN DATE:"

 +3       ;;         does not already exist for this patient.

 +4       ;;

 +5       ;;         (Ordinarily, the program checks this and will not allow

 +6       ;;         two separate entries for the same patient on the same

 +7       ;;         "BEGIN DATE:".  But under this option you, as the Manager,

 +8       ;;         have greater edit capability.)

 +9        SET BWTAB=5

           SET BWLINL="PLOGTX"

           DO PRINTX

 +10       QUIT 

 +11      ;

 +12      ;

EDC       ;EP

 +1       ;---> CALLED BY OPTION: "BW EDIT PREGNANCY LOG".

 +2        DO SETVARS^BWUTL5

 +3        NEW DR,Y

 +4        FOR 

               Begin DoDot:1

 +5                DO TITLE^BWUTL5("EDIT PREGNANCY LOG")

 +6                SET A="   Select PATIENT (or Enter a new DATE): "

 +7                DO DIC^BWFMAN(9002086.05,"QEMAL",.Y,A)

 +8                IF Y<0

                       QUIT 

 +9                DO NAME("^BWEDC(",+Y)

 +10               SET DR=".01;.03;.04;.05///NOW;.06////"_DUZ

 +11               DO DIE^BWFMAN(9002086.05,DR,+Y,.BWPOP)

 +12               IF BWPOP

                       SET Y=-1

               End DoDot:1

               IF $GET(Y)<0

                   QUIT 

 +13       DO EXIT

 +14       QUIT 

 +15      ;

EXIT      ;EP

 +1        WRITE @IOF

 +2        DO KILLALL^BWUTL8

 +3        QUIT 

 +4       ;

PRINTX    ;EP

 +1       ;---> PRINTS TEXT.

 +2        NEW I,T,X

           SET T=""

           FOR I=1:1:BWTAB

               SET T=T_" "

 +3        FOR I=1:1

               SET X=$TEXT(@BWLINL+I)

               IF X'[";;"

                   QUIT 

               WRITE !,T,$PIECE(X,";;",2)

 +4        QUIT 

 +5       ;

NAME(DIC,Y) ;EP

 +1        NEW BWDFN

 +2        SET BWDFN=$PIECE(@(DIC_Y_",0)"),U,2)

 +3        WRITE !!?3,$$NAME^BWUTL1(BWDFN),"   ",$$HRCN^BWUTL1(BWDFN),!

 +4        QUIT 

 +5       ;

 +6       ;

NONE      ;EP

 +1        SET BWTITLE="* There are no PAP Regimen Log entries for this patient. *"

 +2        DO CENTERT^BWUTL5(.BWTITLE)

 +3        WRITE !!!!,BWTITLE,!!

 +4        DO DIRZ^BWUTL3

 +5        QUIT