BWCVD2 ;IHS/CIM/THL - WW ADD/EDIT BW PROCEDURE; [ 07/27/2001 10:04 PM ]
;;2.0;WOMEN'S HEALTH;**7,8**;MAY 16, 1996
;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
;; EDIT A PROCEDURE, ALSO FOLLOW-UP SCREEN. CALLED BY BWPROC.
;
;
EDIT2(DA,BWPOP) ;EP
;---> EDIT A PROCEDURE.
;---> REQUIRED VARIABLES: DA=IEN IN ^BWPCD(.
S BWPOP=0
I '$G(DA) D D OUT^BWUTL3 Q
.W !,"NO PROCEDURE (DA). PLEASE CONTACT YOUR SITE MANAGER."
I '$D(^BWPCD(DA,0)) D D OUT^BWUTL3 Q
.W !,"^BWPCD NOT DEFINED. PLEASE CONTACT YOUR SITE MANAGER."
S (AUPNPAT,BWDFN)=$P(^BWPCD(DA,0),U,2)
D SCREEN(DA,.BWPOP)
;---> IF ENTRY WAS LOCKED, BWPOP=1.
Q:BWPOP
;
;---> NEXT LINES ARE PURELY FOR CDC PURPOSES: IF THIS PROC IS A CBE,
;---> AND IF IT WAS STORED UNDER A PAP, UPDATE THE PAP CBE FIELDS.
I $P(^BWPCD(DA,0),U,4)=27,$$CDC^BWUTL5(DUZ(2)) D
.;---> QUIT IF NOT STORED UNDER A PAP.
.Q:'$D(^BWPCD(DA,2)) Q:'$P(^BWPCD(DA,2),U,36)
.;---> GO UPDATE THE PAP POINTED TO BY FIELD #2.36 OF THIS CBE.
.D ADDCBE1^BWPROC(DA,$P(^BWPCD(DA,2),U,36))
Q
;
;
SCREEN(DA,BWPOP) ;EP
;---> EDIT A PROCEDURE WITH SCREENMAN.
;---> REQUIRED VARIABLES: DA=IEN IN PROCEDURE FILE.
;---> STORE OLD ZERO NODE VALUES IN BWOLD TO COMPARE FOR EDITS,
;---> STORE OLD 2 NODE VALUES IN BWOLD2. IF ZERO NODE HAS CHANGED
;---> RE-EXPORT TO PCC; IF ZERO OR 2 NODE CHANGED, FLAG FOR CDC.
;
N BWOLD,BWOLD2,BWPCDN,DDSFILE,DR,Y
S DDSFILE=9002086.1
S BWOLD=^BWPCD(DA,0) S:$D(^(2)) BWOLD2=^BWPCD(DA,2)
;---> BWCDC=1 IF THIS PROCEDURE SHOULD BE EXPORTED TO CDC.
S BWPCDN=$P(BWOLD,U,4),BWCDC=$$CDCEXP^BWUTL5(BWPCDN,DUZ(2))
;
;---> SET DR=TO THE APPROPRIATE FORM.
D
.;---> IF THIS IS A COLPOSCOPY-TYPE PROCEDURE, USE FORM-2.
.I $$COLP^BWUTL4(DA) S DR="[BW PROC-FORM-2-COLP]" Q
.;
.;---> IF THIS SITE COLLECTS CDC DATA AND THIS IS A PROCEDURE THAT
.;---> SHOULD BE EXPORTED (PAP OR MAM) USE FORM-3-CDC-PAP/MAM.
.I BWCDC!(BWPCDN>24&(BWPCDN<27)) S DR="[BW PROC-FORM-3-CDC-"_$S(BWPCDN=1:"PAP]",1:"MAM]") Q ;IHS/CMI/THL PATCH 8
.;---> OTHERWISE, USE FORM 1 (ONLY PAGE 1).
.I BWPCDN>29,BWPCDN<36 S DR="[BW PROC-FORM-P2]" ;IHS/CMI/THL PATCH 7
.E S DR="[BW PROC-FORM-1]" ;IHS/CMI/THL PATCH 7
;
;---> CALL SCREENMAN.
D DDS^BWFMAN(DDSFILE,DR,DA,"","",.BWPOP)
Q:BWPOP
;
PCC ;---> PCC EXPORT.
;---> QUIT IF THIS IS NOT AN IHS SITE; NO PCC AND NO CDC.
Q:$$AGENCY^BWUTL5(DUZ(2))'="i" ;VAMOD
Q:'$D(DA) Q:'$D(^BWPCD(DA,0))
S BWDA=DA,Y=^BWPCD(DA,0) D
.N DA
.I '$D(^BWPCD(BWDA,"PCC")) D CREATE^BWPCC(BWDA,DUZ(2),Y) Q
.I BWOLD'=Y D EDIT^BWPCC(BWDA,DUZ(2),Y,^BWPCD(BWDA,"PCC")) Q
;
;
CDC ;---> CDC EXPORT.
;---> * !NOT CURRENTLY USED. SAVE IN CASE IMS SWITCHES BACK.
;---> FOR NOW THEY WANT ALL PROCEDURES EXPORTED EACH TIME.
Q
S Y=^BWPCD(DA,0)
;---> IF PROCEDURE WAS EDITED, THEN CHECK TO FLAG FOR CDC EXPORT.
I BWOLD'=Y!($S($D(BWOLD2):BWOLD2'=^BWPCD(DA,2),1:0)) D
.;---> QUIT IF PROCEDURE IS ALREADY MARKED FOR EXPORT.
.Q:$P(Y,U,17)
.;---> QUIT IF PROCEDURE RESULT IS ERROR/DISREGARD.
.Q:$P(Y,U,5)=8
.;---> QUIT IF SITE NOT EXPORTING OR IF PCD SHOULDN'T BE EXPORTED.
.Q:'BWCDC
.;---> FLAG PROCEDURE FOR EXPORT AS AN "UPDATE".
.D DIE^BWFMAN(9002086.1,".17///2",DA,.BWPOP,1)
;
Q
;
;
FOLLOWUP(BWDA) ;EP
;---> PROCEDURE FOLLOW-UP MENU.
;---> REQUIRED VARIABLES: BWDA=IEN IN PROCEDURE FILE.
;---> BWLOOP TELLS BWNOTIF (ADD NEW NOTIFICATION) NOT TO OFFER TO EDIT
;---> CASE DATA, SINCE THAT OPTION IS ALREADY OFFERED IN THIS LOOP.
S BWLOOP=1 N BWPOP,BWPOP1,DIR,DIRUT,Y
F Q:$D(DIRUT) D
.S BWTITLE="* PROCEDURE FOLLOW-UP MENU *" D CENTERT^BWUTL5(.BWTITLE)
.W @IOF,!!,BWTITLE
.;---> PCDVARS (BELOW) PROVIDES: BWACCN,BWDFN,BWPCDN,BWRESN
.D PCDVARS^BWUTL3(DA,1),HEADER41^BWUTL7
.S DIR("A")=" Select A, C, E, P, or <return>: "
.S DIR(0)="SMOA^a:ADD;c:CLOSE;e:EDIT;p:PRINT"
.W !!?3,"To take a Follow-up action on this procedure, choose:"
.W !!?5,"A to ADD a NEW Notification for this patient,"
.W !?5,"C to review and CLOSE any Open Notifications for this patient,"
.W !?5,"E to EDIT this Patient's Case Data,"
.W !?5,"P to PRINT all of the information for this Procedure,"
.D FACE,NORMAL,CBE
.W !?5,"or press <return> to continue.",!
.D ^DIR K DIR
.Q:$D(DIRUT)
.I Y="a" D NEW^BWNOTIF(BWDFN,BWACCN) Q
.I Y="c" D FOLLOW^BWBRNOT(BWDFN) Q
.I Y="e" D SCREEN^BWPATE(BWDFN) Q
.I Y="p" D TOP^BWPRPCD(BWDA) Q
.I Y="f" D FOLLUP^BWFACE(BWDFN) Q
.I Y="q" D NORMALL^BWNOTIF1(BWDFN,BWACCN,BWSPEC,BWSPTX) Q
.I Y="b" D ADDCBE^BWPROC(BWDFN,BWDA) Q
W @IOF
Q
;
FACE ;EP
;---> PRINT A FACE SHEET FOR THIS PATIENT.
W !?5,"F to display/print this Patient's FACE SHEET,"
S DIR("A")=$P(DIR("A"),"or")_"F, or <return>: "
S DIR(0)=DIR(0)_";f:FACE"
Q
;
NORMAL ;EP
;---> IF RESULT IS NORMAL, ADD OPTION TO QUEUE NORMAL PAP/MAM LETTER.
;---> QUIT IF VARIABLES NOT ADEQUATE.
N X
Q:'$G(BWPCDN)!('$G(BWRESN))!('$D(BWACCN))
;
;---> QUIT IF THE RESULT OF THIS PROCEDURE IS NOT NORMAL.
Q:$P(^BWDIAG(BWRESN,0),U,21)
;
;---> FOR PAP BWSPEC=1, FOR ANY TYPE OF MAM BWSPEC=2, OTHERWISE 0.
S BWSPEC=$S(BWPCDN=1:1,$$PMAM^BWUTL6(BWPCDN):2,1:0)
;---> QUIT IF NOT A PAP OR MAM.
Q:'BWSPEC
;
;---> QUIT IF THIS IS PAP (OR MAM) AND "AUTOQUEUE NORMAL PAP (OR MAM)
;---> LETTERS" IS SET TO "NO" IN THE SITE PARAMETERS.
Q:'$D(^BWSITE(DUZ(2),0))
Q:BWSPEC=1&('$P(^BWSITE(DUZ(2),0),U,3))
Q:BWSPEC=2&('$P(^BWSITE(DUZ(2),0),U,7))
;
;---> QUIT IF ANY NOTIFICATION ALREADY EXISTS FOR THIS ACCESSION#.
I $D(^BWNOT("C",BWACCN)) D Q
.W !
.W ?5,"* (One or more Notifications already exist for this Procedure.)"
;
;---> SET TEXT.
S BWSPTX=$S(BWSPEC=1:"PAP",BWSPEC=2:"MAM",1:"?")
W !?5,"Q to QUEUE a """,BWSPTX," Result Normal"" letter "
W "to be sent to this patient,"
S DIR("A")=$P(DIR("A"),"or")_"Q, or <return>: "
S DIR(0)=DIR(0)_";q:QUEUE"
Q
;
CBE ;EP
;---> ENTER A NEW CBE FOR THIS PATIENT.
Q:'$D(^BWSITE(DUZ(2),0))
Q:'$P(^BWSITE(DUZ(2),0),U,9)
W !?5,"B to add a Clinical BREAST Exam for this patient,"
S DIR("A")=$P(DIR("A"),"or")_"B, or <return>: "
S DIR(0)=DIR(0)_";b:BREAST EXAM"
Q
BWCVD2 ;IHS/CIM/THL - WW ADD/EDIT BW PROCEDURE; [ 07/27/2001 10:04 PM ]
+1 ;;2.0;WOMEN'S HEALTH;**7,8**;MAY 16, 1996
+2 ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
+3 ;; EDIT A PROCEDURE, ALSO FOLLOW-UP SCREEN. CALLED BY BWPROC.
+4 ;
+5 ;
EDIT2(DA,BWPOP) ;EP
+1 ;---> EDIT A PROCEDURE.
+2 ;---> REQUIRED VARIABLES: DA=IEN IN ^BWPCD(.
+3 SET BWPOP=0
+4 IF '$GET(DA)
Begin DoDot:1
+5 WRITE !,"NO PROCEDURE (DA). PLEASE CONTACT YOUR SITE MANAGER."
End DoDot:1
DO OUT^BWUTL3
QUIT
+6 IF '$DATA(^BWPCD(DA,0))
Begin DoDot:1
+7 WRITE !,"^BWPCD NOT DEFINED. PLEASE CONTACT YOUR SITE MANAGER."
End DoDot:1
DO OUT^BWUTL3
QUIT
+8 SET (AUPNPAT,BWDFN)=$PIECE(^BWPCD(DA,0),U,2)
+9 DO SCREEN(DA,.BWPOP)
+10 ;---> IF ENTRY WAS LOCKED, BWPOP=1.
+11 IF BWPOP
QUIT
+12 ;
+13 ;---> NEXT LINES ARE PURELY FOR CDC PURPOSES: IF THIS PROC IS A CBE,
+14 ;---> AND IF IT WAS STORED UNDER A PAP, UPDATE THE PAP CBE FIELDS.
+15 IF $PIECE(^BWPCD(DA,0),U,4)=27
IF $$CDC^BWUTL5(DUZ(2))
Begin DoDot:1
+16 ;---> QUIT IF NOT STORED UNDER A PAP.
+17 IF '$DATA(^BWPCD(DA,2))
QUIT
IF '$PIECE(^BWPCD(DA,2),U,36)
QUIT
+18 ;---> GO UPDATE THE PAP POINTED TO BY FIELD #2.36 OF THIS CBE.
+19 DO ADDCBE1^BWPROC(DA,$PIECE(^BWPCD(DA,2),U,36))
End DoDot:1
+20 QUIT
+21 ;
+22 ;
SCREEN(DA,BWPOP) ;EP
+1 ;---> EDIT A PROCEDURE WITH SCREENMAN.
+2 ;---> REQUIRED VARIABLES: DA=IEN IN PROCEDURE FILE.
+3 ;---> STORE OLD ZERO NODE VALUES IN BWOLD TO COMPARE FOR EDITS,
+4 ;---> STORE OLD 2 NODE VALUES IN BWOLD2. IF ZERO NODE HAS CHANGED
+5 ;---> RE-EXPORT TO PCC; IF ZERO OR 2 NODE CHANGED, FLAG FOR CDC.
+6 ;
+7 NEW BWOLD,BWOLD2,BWPCDN,DDSFILE,DR,Y
+8 SET DDSFILE=9002086.1
+9 SET BWOLD=^BWPCD(DA,0)
IF $DATA(^(2))
SET BWOLD2=^BWPCD(DA,2)
+10 ;---> BWCDC=1 IF THIS PROCEDURE SHOULD BE EXPORTED TO CDC.
+11 SET BWPCDN=$PIECE(BWOLD,U,4)
SET BWCDC=$$CDCEXP^BWUTL5(BWPCDN,DUZ(2))
+12 ;
+13 ;---> SET DR=TO THE APPROPRIATE FORM.
+14 Begin DoDot:1
+15 ;---> IF THIS IS A COLPOSCOPY-TYPE PROCEDURE, USE FORM-2.
+16 IF $$COLP^BWUTL4(DA)
SET DR="[BW PROC-FORM-2-COLP]"
QUIT
+17 ;
+18 ;---> IF THIS SITE COLLECTS CDC DATA AND THIS IS A PROCEDURE THAT
+19 ;---> SHOULD BE EXPORTED (PAP OR MAM) USE FORM-3-CDC-PAP/MAM.
+20 ;IHS/CMI/THL PATCH 8
IF BWCDC!(BWPCDN>24&(BWPCDN<27))
SET DR="[BW PROC-FORM-3-CDC-"_$SELECT(BWPCDN=1:"PAP]",1:"MAM]")
QUIT
+21 ;---> OTHERWISE, USE FORM 1 (ONLY PAGE 1).
+22 ;IHS/CMI/THL PATCH 7
IF BWPCDN>29
IF BWPCDN<36
SET DR="[BW PROC-FORM-P2]"
+23 ;IHS/CMI/THL PATCH 7
IF '$TEST
SET DR="[BW PROC-FORM-1]"
End DoDot:1
+24 ;
+25 ;---> CALL SCREENMAN.
+26 DO DDS^BWFMAN(DDSFILE,DR,DA,"","",.BWPOP)
+27 IF BWPOP
QUIT
+28 ;
PCC ;---> PCC EXPORT.
+1 ;---> QUIT IF THIS IS NOT AN IHS SITE; NO PCC AND NO CDC.
+2 ;VAMOD
IF $$AGENCY^BWUTL5(DUZ(2))'="i"
QUIT
+3 IF '$DATA(DA)
QUIT
IF '$DATA(^BWPCD(DA,0))
QUIT
+4 SET BWDA=DA
SET Y=^BWPCD(DA,0)
Begin DoDot:1
+5 NEW DA
+6 IF '$DATA(^BWPCD(BWDA,"PCC"))
DO CREATE^BWPCC(BWDA,DUZ(2),Y)
QUIT
+7 IF BWOLD'=Y
DO EDIT^BWPCC(BWDA,DUZ(2),Y,^BWPCD(BWDA,"PCC"))
QUIT
End DoDot:1
+8 ;
+9 ;
CDC ;---> CDC EXPORT.
+1 ;---> * !NOT CURRENTLY USED. SAVE IN CASE IMS SWITCHES BACK.
+2 ;---> FOR NOW THEY WANT ALL PROCEDURES EXPORTED EACH TIME.
+3 QUIT
+4 SET Y=^BWPCD(DA,0)
+5 ;---> IF PROCEDURE WAS EDITED, THEN CHECK TO FLAG FOR CDC EXPORT.
+6 IF BWOLD'=Y!($SELECT($DATA(BWOLD2):BWOLD2'=^BWPCD(DA,2),1:0))
Begin DoDot:1
+7 ;---> QUIT IF PROCEDURE IS ALREADY MARKED FOR EXPORT.
+8 IF $PIECE(Y,U,17)
QUIT
+9 ;---> QUIT IF PROCEDURE RESULT IS ERROR/DISREGARD.
+10 IF $PIECE(Y,U,5)=8
QUIT
+11 ;---> QUIT IF SITE NOT EXPORTING OR IF PCD SHOULDN'T BE EXPORTED.
+12 IF 'BWCDC
QUIT
+13 ;---> FLAG PROCEDURE FOR EXPORT AS AN "UPDATE".
+14 DO DIE^BWFMAN(9002086.1,".17///2",DA,.BWPOP,1)
End DoDot:1
+15 ;
+16 QUIT
+17 ;
+18 ;
FOLLOWUP(BWDA) ;EP
+1 ;---> PROCEDURE FOLLOW-UP MENU.
+2 ;---> REQUIRED VARIABLES: BWDA=IEN IN PROCEDURE FILE.
+3 ;---> BWLOOP TELLS BWNOTIF (ADD NEW NOTIFICATION) NOT TO OFFER TO EDIT
+4 ;---> CASE DATA, SINCE THAT OPTION IS ALREADY OFFERED IN THIS LOOP.
+5 SET BWLOOP=1
NEW BWPOP,BWPOP1,DIR,DIRUT,Y
+6 FOR
IF $DATA(DIRUT)
QUIT
Begin DoDot:1
+7 SET BWTITLE="* PROCEDURE FOLLOW-UP MENU *"
DO CENTERT^BWUTL5(.BWTITLE)
+8 WRITE @IOF,!!,BWTITLE
+9 ;---> PCDVARS (BELOW) PROVIDES: BWACCN,BWDFN,BWPCDN,BWRESN
+10 DO PCDVARS^BWUTL3(DA,1)
DO HEADER41^BWUTL7
+11 SET DIR("A")=" Select A, C, E, P, or <return>: "
+12 SET DIR(0)="SMOA^a:ADD;c:CLOSE;e:EDIT;p:PRINT"
+13 WRITE !!?3,"To take a Follow-up action on this procedure, choose:"
+14 WRITE !!?5,"A to ADD a NEW Notification for this patient,"
+15 WRITE !?5,"C to review and CLOSE any Open Notifications for this patient,"
+16 WRITE !?5,"E to EDIT this Patient's Case Data,"
+17 WRITE !?5,"P to PRINT all of the information for this Procedure,"
+18 DO FACE
DO NORMAL
DO CBE
+19 WRITE !?5,"or press <return> to continue.",!
+20 DO ^DIR
KILL DIR
+21 IF $DATA(DIRUT)
QUIT
+22 IF Y="a"
DO NEW^BWNOTIF(BWDFN,BWACCN)
QUIT
+23 IF Y="c"
DO FOLLOW^BWBRNOT(BWDFN)
QUIT
+24 IF Y="e"
DO SCREEN^BWPATE(BWDFN)
QUIT
+25 IF Y="p"
DO TOP^BWPRPCD(BWDA)
QUIT
+26 IF Y="f"
DO FOLLUP^BWFACE(BWDFN)
QUIT
+27 IF Y="q"
DO NORMALL^BWNOTIF1(BWDFN,BWACCN,BWSPEC,BWSPTX)
QUIT
+28 IF Y="b"
DO ADDCBE^BWPROC(BWDFN,BWDA)
QUIT
End DoDot:1
+29 WRITE @IOF
+30 QUIT
+31 ;
FACE ;EP
+1 ;---> PRINT A FACE SHEET FOR THIS PATIENT.
+2 WRITE !?5,"F to display/print this Patient's FACE SHEET,"
+3 SET DIR("A")=$PIECE(DIR("A"),"or")_"F, or <return>: "
+4 SET DIR(0)=DIR(0)_";f:FACE"
+5 QUIT
+6 ;
NORMAL ;EP
+1 ;---> IF RESULT IS NORMAL, ADD OPTION TO QUEUE NORMAL PAP/MAM LETTER.
+2 ;---> QUIT IF VARIABLES NOT ADEQUATE.
+3 NEW X
+4 IF '$GET(BWPCDN)!('$GET(BWRESN))!('$DATA(BWACCN))
QUIT
+5 ;
+6 ;---> QUIT IF THE RESULT OF THIS PROCEDURE IS NOT NORMAL.
+7 IF $PIECE(^BWDIAG(BWRESN,0),U,21)
QUIT
+8 ;
+9 ;---> FOR PAP BWSPEC=1, FOR ANY TYPE OF MAM BWSPEC=2, OTHERWISE 0.
+10 SET BWSPEC=$SELECT(BWPCDN=1:1,$$PMAM^BWUTL6(BWPCDN):2,1:0)
+11 ;---> QUIT IF NOT A PAP OR MAM.
+12 IF 'BWSPEC
QUIT
+13 ;
+14 ;---> QUIT IF THIS IS PAP (OR MAM) AND "AUTOQUEUE NORMAL PAP (OR MAM)
+15 ;---> LETTERS" IS SET TO "NO" IN THE SITE PARAMETERS.
+16 IF '$DATA(^BWSITE(DUZ(2),0))
QUIT
+17 IF BWSPEC=1&('$PIECE(^BWSITE(DUZ(2),0),U,3))
QUIT
+18 IF BWSPEC=2&('$PIECE(^BWSITE(DUZ(2),0),U,7))
QUIT
+19 ;
+20 ;---> QUIT IF ANY NOTIFICATION ALREADY EXISTS FOR THIS ACCESSION#.
+21 IF $DATA(^BWNOT("C",BWACCN))
Begin DoDot:1
+22 WRITE !
+23 WRITE ?5,"* (One or more Notifications already exist for this Procedure.)"
End DoDot:1
QUIT
+24 ;
+25 ;---> SET TEXT.
+26 SET BWSPTX=$SELECT(BWSPEC=1:"PAP",BWSPEC=2:"MAM",1:"?")
+27 WRITE !?5,"Q to QUEUE a """,BWSPTX," Result Normal"" letter "
+28 WRITE "to be sent to this patient,"
+29 SET DIR("A")=$PIECE(DIR("A"),"or")_"Q, or <return>: "
+30 SET DIR(0)=DIR(0)_";q:QUEUE"
+31 QUIT
+32 ;
CBE ;EP
+1 ;---> ENTER A NEW CBE FOR THIS PATIENT.
+2 IF '$DATA(^BWSITE(DUZ(2),0))
QUIT
+3 IF '$PIECE(^BWSITE(DUZ(2),0),U,9)
QUIT
+4 WRITE !?5,"B to add a Clinical BREAST Exam for this patient,"
+5 SET DIR("A")=$PIECE(DIR("A"),"or")_"B, or <return>: "
+6 SET DIR(0)=DIR(0)_";b:BREAST EXAM"
+7 QUIT
