BWPCC1 ;IHS/ANMC/MWR - WOMEN'S HEALTH PCC LINK;15-Feb-2003 22:06;PLS
;;2.0;WOMEN'S HEALTH;**8**;MAY 16, 1996
;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
;; SUBROUTINES FOR BWPCC (CREATE/EDIT A VISIT & V FILE ENTRIES).
;; CHECK ON PASSING A PROCEDURE. CHECK ON PCC SET UP CORRECTLY.
;
;
CHECK(BW0,BWDUZ0,BWDUZ2,BWPCDN,BWSITE,BWVFIL) ;EP
;---> CHECK TO SEE IF THIS PROCEDURE CAN BE PASSED TO PCC.
N BWPCCP,DIC,Y
;---> QUIT IF THERE IS NO PROCEDURE TYPE, NO SITE WHERE PERFORMED,
;---> OR NO V FILE# FOR THIS PROCEDURE.
Q:'BWPCDN!('BWSITE)!('BWVFIL) 1
;
;---> QUIT IF THE RESULT OF THE PROCEDURE IS "ERROR/DISREGARD".
Q:$P(BW0,U,5)=8 2
;
;---> QUIT IF RPMS SITE FILE IS NOT PRESENT AT THIS SITE.
Q:'$D(^AUTTSITE(1,0)) 3
;
;---> QUIT IF PCC IS NOT PRESENT AT THIS SITE (RPMS SITE FILE).
Q:$P(^AUTTSITE(1,0),U,8)'="Y" 4
;
;---> QUIT IF NO PCC MASTER CONTROL FILE FOR THIS SITE.
Q:'$D(^APCCCTRL(BWDUZ2)) 5
;
;---> QUIT IF WOMEN'S HEALTH IS NOT IN THE PACKAGE FILE.
D DIC^BWFMAN(9.4,"Q",.Y,"","","","WOMEN'S HEALTH")
Q:Y<0 6
;
;---> QUIT IF WOMEN'S HEALTH IS NOT IN PCC MASTER CONTROL FILE OR IF
;---> "PASS DATA TO PCC" IS "NO".
Q:'$D(^APCCCTRL(BWDUZ2,11,+Y,0)) 7
Q:'$P(^APCCCTRL(BWDUZ2,11,+Y,0),U,2) 8
;
;---> QUIT IF VISIT TYPE ISN'T DEFINED IN PCC MASTER CONTROL FILE.
Q:$P(^APCCCTRL(BWDUZ2,0),U,4)']"" 9
;
;---> QUIT IF PCC DATE/TIME FIELD IS NULL.
Q:'$P(BW0,U,3) 10
;
;---> QUIT IF THIS SITE DOES NOT HAVE THE PCC PARAMETER SET FOR
;---> THIS PROCEDURE TYPE.
S BWPCCP=$P($G(^BWSITE(BWDUZ2,BWPCDN)),U,2)
Q:BWPCCP']"" 11
;
;---> QUIT IF THIS PROC WAS ON-SITE AND SHOULD NOT BE PASSED.
Q:BWSITE=BWDUZ2&("fn"[BWPCCP) 12
;
;---> QUIT IF THIS PROC WAS OFF-SITE AND SHOULD NOT BE PASSED.
Q:BWSITE'=BWDUZ2&("on"[BWPCCP) 13
;
;---> QUIT IF THIS PROCEDURE TYPE DOES NOT HAVE A .01 VALUE TO PASS.
Q:((BWVFIL=9000010.08)&('$P(^BWPN(BWPCDN,0),U,14))) 14
Q:((BWVFIL=9000010.09)&('$P(^BWPN(BWPCDN,0),U,15))) 15
Q:((BWVFIL=9000010.13)&('$P(^BWPN(BWPCDN,0),U,16))) 16
Q:((BWVFIL=9000010.22)&('$P(^BWPN(BWPCDN,0),U,17))) 17
;
;---> QUIT IF PROBLEMS POINTING TO THE RADIOLOGY PROCEDURES FILE #71.
I BWVFIL=9000010.22 D I Y Q Y
.N Z S Y=0,Z=+$P($P(^DD(BWVFIL,.01,0),U,2),"P",2)
.I 'Z S Y=19 Q
.S P=^DIC(Z,0,"GL")_$P(^BWPN(BWPCDN,0),U,17)_",0)"
.I '$D(@P) S Y=20 Q
;
;---> QUIT IF USER DOES NOT HAVE PROPER PERMISSIONS.
I BWDUZ0'["M"&(BWDUZ0'["@") D Q 18
.W !?5,"* You do not have the required permission for the PCC Link."
.W !?7,"Please contact your site manager." D DIRZ^BWUTL3
Q 0
;
;
LINK ;EP
;---> DISPLAY PCC-WOMEN'S HEALTH LINK STATUS
N X D SETVARS^BWUTL5
S:'$D(IOF) IOF="!!!"
W @IOF
W !?21,"WOMEN'S HEALTH-PCC LINK ENVIRONMENT"
W !?18,"------------------------------------------",!?8
W "(All parameters must be ""YES"" for PCC link to be operational.)",!
;
D
.I '$D(^AUTTSITE(1,0)) D Q
..W !!?5,"1) RPMS SITE file is present:" D DOTS W "NO"
.W !!?5,"1) PCC is running at this site (RPMS SITE file):" D DOTS
.W $S($P(^AUTTSITE(1,0),U,8)="Y":"YES",1:"NO")
;
W !!?5,"2) PCC MASTER CONTROL file is defined for this site:" D DOTS
S X=$D(^APCCCTRL(DUZ(2))) W $S(X:"YES",1:"NO")
;
W !!?5,"3) VISIT TYPE is defined in the PCC MASTER CONTROL file:"
D DOTS
W $S('X:"NO",$P(^APCCCTRL(DUZ(2),0),U,4)]"":"YES",1:"NO") K X
;
W !!?5,"4) WOMEN'S HEALTH is defined in the PACKAGE file:" D DOTS
D DIC^BWFMAN(9.4,"Q",.Y,"","","","WOMEN'S HEALTH")
W $S(Y:"YES",1:"NO")
;
W !!?5,"5) WOMEN'S HEALTH entry exists in the PCC MASTER CONTROL file:"
D DOTS
W $S($D(^APCCCTRL(DUZ(2),11,+Y,0)):"YES",1:"NO")
;
I $D(^APCCCTRL(DUZ(2),11,+Y,0)) D
.W !!?5,"6) WOMEN'S HEALTH entry in PCC MASTER CONTROL file has"
.W !?8,"""PASS DATA TO PCC"" set to:" D DOTS
.W $S('Y:"NO",$P(^APCCCTRL(DUZ(2),11,+Y,0),U,2):"YES",1:"NO")
;
D DIRZ^BWUTL3
Q
;
DOTS ;
F I=1:1:(69-$X) W "."
Q
;
;
DISPLAY1 ;EP
;---> DISPLAY VISIT IEN.
I $D(APCDALVR("APCDVSIT")) D
.W !,"APCDVSIT DEFINED: ",APCDALVR("APCDVSIT")
I $D(APCDALVR("APCDVSIT","NEW")) D
.W !,"NEW VISIT: ",APCDALVR("APCDVSIT","NEW")
;---> SHOW FLAG IF VISIT WAS NOT CREATED.
I $D(APCDALVR("APCDAFLG")) D
.W !,"APCDAFLG DEFINED, FAILED: ",APCDALVR("APCDAFLG")
D DIRZ^BWUTL3
Q
;
DISPLAY2 ;EP
;---> DISPLAY V FILE IEN.
I $D(APCDALVR("APCDADFN")) D
.W !,"APCDADFN DEFINED: ",APCDALVR("APCDADFN")
;---> SHOW FLAG IF VISIT WAS NOT CREATED.
I $D(APCDALVR("APCDAFLG")) D
.W !,"APCDAFLG DEFINED, FAILED: ",APCDALVR("APCDAFLG")
D DIRZ^BWUTL3
Q
;
DISPLAY3 ;EP
;---> DISPLAY VISIT AND V FILE GLOBAL NODES AND FILE#70 IENS.
W !!,"VISIT FILE: "
S N=APCDALVR("APCDVSIT")-3 S:N<0 N=0
F S N=$O(^AUPNVSIT(N)) Q:'N D
.W !,N,": ",^AUPNVSIT(N,0)
;
W !!,"V FILE: "
S BWVGBL=^DIC(BWVFIL,0,"GL")
S N=APCDALVR("APCDADFN")-3,M=N+10 S:N<0 N=0
F S N=$O(@(BWVGBL_"N)")) Q:'N Q:N>M D
.W !,N,": ",@(BWVGBL_"N,0)")
D DIRZ^BWUTL3
Q
BWPCC1 ;IHS/ANMC/MWR - WOMEN'S HEALTH PCC LINK;15-Feb-2003 22:06;PLS
+1 ;;2.0;WOMEN'S HEALTH;**8**;MAY 16, 1996
+2 ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
+3 ;; SUBROUTINES FOR BWPCC (CREATE/EDIT A VISIT & V FILE ENTRIES).
+4 ;; CHECK ON PASSING A PROCEDURE. CHECK ON PCC SET UP CORRECTLY.
+5 ;
+6 ;
CHECK(BW0,BWDUZ0,BWDUZ2,BWPCDN,BWSITE,BWVFIL) ;EP
+1 ;---> CHECK TO SEE IF THIS PROCEDURE CAN BE PASSED TO PCC.
+2 NEW BWPCCP,DIC,Y
+3 ;---> QUIT IF THERE IS NO PROCEDURE TYPE, NO SITE WHERE PERFORMED,
+4 ;---> OR NO V FILE# FOR THIS PROCEDURE.
+5 IF 'BWPCDN!('BWSITE)!('BWVFIL)
QUIT 1
+6 ;
+7 ;---> QUIT IF THE RESULT OF THE PROCEDURE IS "ERROR/DISREGARD".
+8 IF $PIECE(BW0,U,5)=8
QUIT 2
+9 ;
+10 ;---> QUIT IF RPMS SITE FILE IS NOT PRESENT AT THIS SITE.
+11 IF '$DATA(^AUTTSITE(1,0))
QUIT 3
+12 ;
+13 ;---> QUIT IF PCC IS NOT PRESENT AT THIS SITE (RPMS SITE FILE).
+14 IF $PIECE(^AUTTSITE(1,0),U,8)'="Y"
QUIT 4
+15 ;
+16 ;---> QUIT IF NO PCC MASTER CONTROL FILE FOR THIS SITE.
+17 IF '$DATA(^APCCCTRL(BWDUZ2))
QUIT 5
+18 ;
+19 ;---> QUIT IF WOMEN'S HEALTH IS NOT IN THE PACKAGE FILE.
+20 DO DIC^BWFMAN(9.4,"Q",.Y,"","","","WOMEN'S HEALTH")
+21 IF Y<0
QUIT 6
+22 ;
+23 ;---> QUIT IF WOMEN'S HEALTH IS NOT IN PCC MASTER CONTROL FILE OR IF
+24 ;---> "PASS DATA TO PCC" IS "NO".
+25 IF '$DATA(^APCCCTRL(BWDUZ2,11,+Y,0))
QUIT 7
+26 IF '$PIECE(^APCCCTRL(BWDUZ2,11,+Y,0),U,2)
QUIT 8
+27 ;
+28 ;---> QUIT IF VISIT TYPE ISN'T DEFINED IN PCC MASTER CONTROL FILE.
+29 IF $PIECE(^APCCCTRL(BWDUZ2,0),U,4)']""
QUIT 9
+30 ;
+31 ;---> QUIT IF PCC DATE/TIME FIELD IS NULL.
+32 IF '$PIECE(BW0,U,3)
QUIT 10
+33 ;
+34 ;---> QUIT IF THIS SITE DOES NOT HAVE THE PCC PARAMETER SET FOR
+35 ;---> THIS PROCEDURE TYPE.
+36 SET BWPCCP=$PIECE($GET(^BWSITE(BWDUZ2,BWPCDN)),U,2)
+37 IF BWPCCP']""
QUIT 11
+38 ;
+39 ;---> QUIT IF THIS PROC WAS ON-SITE AND SHOULD NOT BE PASSED.
+40 IF BWSITE=BWDUZ2&("fn"[BWPCCP)
QUIT 12
+41 ;
+42 ;---> QUIT IF THIS PROC WAS OFF-SITE AND SHOULD NOT BE PASSED.
+43 IF BWSITE'=BWDUZ2&("on"[BWPCCP)
QUIT 13
+44 ;
+45 ;---> QUIT IF THIS PROCEDURE TYPE DOES NOT HAVE A .01 VALUE TO PASS.
+46 IF ((BWVFIL=9000010.08)&('$PIECE(^BWPN(BWPCDN,0),U,14)))
QUIT 14
+47 IF ((BWVFIL=9000010.09)&('$PIECE(^BWPN(BWPCDN,0),U,15)))
QUIT 15
+48 IF ((BWVFIL=9000010.13)&('$PIECE(^BWPN(BWPCDN,0),U,16)))
QUIT 16
+49 IF ((BWVFIL=9000010.22)&('$PIECE(^BWPN(BWPCDN,0),U,17)))
QUIT 17
+50 ;
+51 ;---> QUIT IF PROBLEMS POINTING TO THE RADIOLOGY PROCEDURES FILE #71.
+52 IF BWVFIL=9000010.22
Begin DoDot:1
+53 NEW Z
SET Y=0
SET Z=+$PIECE($PIECE(^DD(BWVFIL,.01,0),U,2),"P",2)
+54 IF 'Z
SET Y=19
QUIT
+55 SET P=^DIC(Z,0,"GL")_$PIECE(^BWPN(BWPCDN,0),U,17)_",0)"
+56 IF '$DATA(@P)
SET Y=20
QUIT
End DoDot:1
IF Y
QUIT Y
+57 ;
+58 ;---> QUIT IF USER DOES NOT HAVE PROPER PERMISSIONS.
+59 IF BWDUZ0'["M"&(BWDUZ0'["@")
Begin DoDot:1
+60 WRITE !?5,"* You do not have the required permission for the PCC Link."
+61 WRITE !?7,"Please contact your site manager."
DO DIRZ^BWUTL3
End DoDot:1
QUIT 18
+62 QUIT 0
+63 ;
+64 ;
LINK ;EP
+1 ;---> DISPLAY PCC-WOMEN'S HEALTH LINK STATUS
+2 NEW X
DO SETVARS^BWUTL5
+3 IF '$DATA(IOF)
SET IOF="!!!"
+4 WRITE @IOF
+5 WRITE !?21,"WOMEN'S HEALTH-PCC LINK ENVIRONMENT"
+6 WRITE !?18,"------------------------------------------",!?8
+7 WRITE "(All parameters must be ""YES"" for PCC link to be operational.)",!
+8 ;
+9 Begin DoDot:1
+10 IF '$DATA(^AUTTSITE(1,0))
Begin DoDot:2
+11 WRITE !!?5,"1) RPMS SITE file is present:"
DO DOTS
WRITE "NO"
End DoDot:2
QUIT
+12 WRITE !!?5,"1) PCC is running at this site (RPMS SITE file):"
DO DOTS
+13 WRITE $SELECT($PIECE(^AUTTSITE(1,0),U,8)="Y":"YES",1:"NO")
End DoDot:1
+14 ;
+15 WRITE !!?5,"2) PCC MASTER CONTROL file is defined for this site:"
DO DOTS
+16 SET X=$DATA(^APCCCTRL(DUZ(2)))
WRITE $SELECT(X:"YES",1:"NO")
+17 ;
+18 WRITE !!?5,"3) VISIT TYPE is defined in the PCC MASTER CONTROL file:"
+19 DO DOTS
+20 WRITE $SELECT('X:"NO",$PIECE(^APCCCTRL(DUZ(2),0),U,4)]"":"YES",1:"NO")
KILL X
+21 ;
+22 WRITE !!?5,"4) WOMEN'S HEALTH is defined in the PACKAGE file:"
DO DOTS
+23 DO DIC^BWFMAN(9.4,"Q",.Y,"","","","WOMEN'S HEALTH")
+24 WRITE $SELECT(Y:"YES",1:"NO")
+25 ;
+26 WRITE !!?5,"5) WOMEN'S HEALTH entry exists in the PCC MASTER CONTROL file:"
+27 DO DOTS
+28 WRITE $SELECT($DATA(^APCCCTRL(DUZ(2),11,+Y,0)):"YES",1:"NO")
+29 ;
+30 IF $DATA(^APCCCTRL(DUZ(2),11,+Y,0))
Begin DoDot:1
+31 WRITE !!?5,"6) WOMEN'S HEALTH entry in PCC MASTER CONTROL file has"
+32 WRITE !?8,"""PASS DATA TO PCC"" set to:"
DO DOTS
+33 WRITE $SELECT('Y:"NO",$PIECE(^APCCCTRL(DUZ(2),11,+Y,0),U,2):"YES",1:"NO")
End DoDot:1
+34 ;
+35 DO DIRZ^BWUTL3
+36 QUIT
+37 ;
DOTS ;
+1 FOR I=1:1:(69-$X)
WRITE "."
+2 QUIT
+3 ;
+4 ;
DISPLAY1 ;EP
+1 ;---> DISPLAY VISIT IEN.
+2 IF $DATA(APCDALVR("APCDVSIT"))
Begin DoDot:1
+3 WRITE !,"APCDVSIT DEFINED: ",APCDALVR("APCDVSIT")
End DoDot:1
+4 IF $DATA(APCDALVR("APCDVSIT","NEW"))
Begin DoDot:1
+5 WRITE !,"NEW VISIT: ",APCDALVR("APCDVSIT","NEW")
End DoDot:1
+6 ;---> SHOW FLAG IF VISIT WAS NOT CREATED.
+7 IF $DATA(APCDALVR("APCDAFLG"))
Begin DoDot:1
+8 WRITE !,"APCDAFLG DEFINED, FAILED: ",APCDALVR("APCDAFLG")
End DoDot:1
+9 DO DIRZ^BWUTL3
+10 QUIT
+11 ;
DISPLAY2 ;EP
+1 ;---> DISPLAY V FILE IEN.
+2 IF $DATA(APCDALVR("APCDADFN"))
Begin DoDot:1
+3 WRITE !,"APCDADFN DEFINED: ",APCDALVR("APCDADFN")
End DoDot:1
+4 ;---> SHOW FLAG IF VISIT WAS NOT CREATED.
+5 IF $DATA(APCDALVR("APCDAFLG"))
Begin DoDot:1
+6 WRITE !,"APCDAFLG DEFINED, FAILED: ",APCDALVR("APCDAFLG")
End DoDot:1
+7 DO DIRZ^BWUTL3
+8 QUIT
+9 ;
DISPLAY3 ;EP
+1 ;---> DISPLAY VISIT AND V FILE GLOBAL NODES AND FILE#70 IENS.
+2 WRITE !!,"VISIT FILE: "
+3 SET N=APCDALVR("APCDVSIT")-3
IF N<0
SET N=0
+4 FOR
SET N=$ORDER(^AUPNVSIT(N))
IF 'N
QUIT
Begin DoDot:1
+5 WRITE !,N,": ",^AUPNVSIT(N,0)
End DoDot:1
+6 ;
+7 WRITE !!,"V FILE: "
+8 SET BWVGBL=^DIC(BWVFIL,0,"GL")
+9 SET N=APCDALVR("APCDADFN")-3
SET M=N+10
IF N<0
SET N=0
+10 FOR
SET N=$ORDER(@(BWVGBL_"N)"))
IF 'N
QUIT
IF N>M
QUIT
Begin DoDot:1
+11 WRITE !,N,": ",@(BWVGBL_"N,0)")
End DoDot:1
+12 DO DIRZ^BWUTL3
+13 QUIT
