Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BWUTL4

BWUTL4.m

Go to the documentation of this file.
  1. BWUTL4 ;IHS/ANMC/MWR - UTIL: DATE DEFAULTS, OTH VALUES;23-Jan-2009 10:35;DU
  1. ;;2.0;WOMEN'S HEALTH;**8,9,11**;MAY 16, 1996
  1. ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
  1. ;; UTILITY: DEFAULT "COMPLETE BY" DATES FOR NOTIFS AND PROCEDURES,
  1. ;; STATUS TEXT, DIAG TEXT, NORMAL VALUE, COLP VALUE, MARGIN? VALUE.
  1. ;
  1. ;
  1. NDELQ() ;EP
  1. ;---> FOR NOTIFICATIONS:
  1. ;---> COMPUTE DEFAULT "COMPLETE BY (DATE)" - DATE AT WHICH A
  1. ;---> NOTIFICATION BECOMES DELINQUENT. CALLED BY BW NOTIF-EDITBLK-1.
  1. ;---> DEFAULT IS CREATED WHEN SCREEN IS FIRST LOADED.
  1. ;---> CODE HERE SETS X=EITHER 1: PRINT DATE (IF PRINTABLE), OR
  1. ;---> 2: DATE NOTIFICATION OPENED, OR
  1. ;---> 3: TODAY'S DATE
  1. ;---> THEN $$NDELQ1() IS CALLED TO ADD 30 DAYS UNTIL DELINQUENT.
  1. ;---> REQUIRED VARIABLE: DA (IEN OF NOTIFICATION).
  1. N X
  1. Q:'$D(DA) ""
  1. Q:'DA ""
  1. Q:'$D(^BWNOT(DA,0)) ""
  1. S X=$P(^BWNOT(DA,0),U,11)
  1. S:'X X=$P(^BWNOT(DA,0),U,2)
  1. S:'X X=DT
  1. Q $$NDELQ1
  1. ;
  1. NDELQ1() ;EP
  1. ;---> FOR NOTIFICATIONS:
  1. ;---> COMPUTE "COMPLETE BY (DATE)". CALLED BY UPDATE/EDIT OF
  1. ;---> "PRINT DATE:" IN BW NOTIF-EDITBLK-1.
  1. ;---> X1=EITHER NEW PRINT DATE, OR DATE NOTIF OPENED, OR TODAY.
  1. ;---> X2=30 DAYS ADDED TILL NOTIFICATION BECOMES DELINQUENT.
  1. ;---> REQUIRED VARIABLE: X=PRINT DATE, OR DATE OPENED, OR TODAY.
  1. N %H,X1,X2
  1. Q:'$D(X) ""
  1. Q:'X ""
  1. S X1=X,X2=30
  1. D C^%DTC
  1. Q X
  1. ;
  1. PDELQ(DA,DUZ2) ;EP
  1. ;---> FOR PROCEDURES:
  1. ;---> COMPUTE DEFAULT "COMPLETE BY (DATE)" - DATE AT WHICH A
  1. ;---> PROCEDURE BECOMES DELINQUENT. CALLED BY BW PROC-EDITBLK-1.
  1. ;---> DEFAULT IS CREATED WHEN SCREEN IS FIRST LOADED.
  1. ;---> CODE HERE FIRST RETRIEVES STORED DATE OF PROCEDURE, THEN CALLS
  1. ;---> $$DELQ1 TO COMPUTE "COMPLETE BY (DATE)".
  1. ;---> REQUIRED VARIABLE: DA (IEN OF PROCEDURE), DUZ2=DUZ(2).
  1. Q:'$G(DA)!('$G(DUZ2)) ""
  1. Q:'$D(^BWPCD(DA,0)) ""
  1. Q:'$P(^BWPCD(DA,0),U,12) ""
  1. Q $$PDELQ1(DA,$P(^BWPCD(DA,0),U,12),DUZ2)
  1. ;
  1. PDELQ1(BWDA,BWDT,BWDUZ2) ;EP
  1. ;---> FOR PROCEDURES:
  1. ;---> COMPUTE "COMPLETE BY (BWDT)". CALLED BY UPBWDT/EDIT OF
  1. ;---> "BWDT OF PROCEDURE" IN BW PROC-EDITBLK-1.
  1. ;---> X1=BWDT OF PROCEDURE, X2=DEFAULT NUMBER OF BWDAYS THE
  1. ;---> PROCEDURE IS ALLOWED TO REMAIN OPEN BEFORE BECOMING DELINQUENT.
  1. ;---> REQUIRED VARIABLE: BWDA=IEN OF PROCEDURE, BWDT=DATE OF PROCEDURE,
  1. ;---> BWDUZ2=DUZ(2).
  1. N %H,X,X1,X2
  1. Q:'$G(BWDA)!('$G(BWDT)) ""
  1. Q:'$D(^BWPCD(BWDA,0)) ""
  1. S X2=$P(^BWPCD(BWDA,0),U,4),X1=BWDT
  1. Q:'X2 ""
  1. Q:'$D(^BWSITE(BWDUZ2,X2)) ""
  1. S X2=$P(^BWSITE(BWDUZ2,X2),U,3)
  1. D C^%DTC
  1. Q X
  1. ;
  1. STATUS() ;EP
  1. ;---> PROVIDES STATUS (OPEN, DELINQUENT, OR CLOSED).
  1. ;---> Y MUST EQUAL ZERO NODE OF NOTIFICATION.
  1. ;---> REQUIRED VARIABLE: Y=ZERO NODE OF PROCEDURE, DT=FFDATE
  1. Q:'$D(Y) "UNKNOWN"
  1. Q:$P(Y,U,14)="c" "CLOSED"
  1. Q:$P(Y,U,14)="n" "NEW"
  1. Q:$P(Y,U,14)="e" "ERROR"
  1. Q:$P(Y,U,13)]""&($P(Y,U,13)<DT) "DELINQ"
  1. Q "OPEN"
  1. ;
  1. DIAG(IEN) ;EP
  1. ;---> RETURN TEXT OF RESULT/DIAGNOSIS.
  1. ;---> REQUIRED VARIABLE X=IEN IN BW RESULTS/DIAGNOSIS FILE 9002086.31.
  1. Q:'$G(IEN) "NOT ENTERED"
  1. Q:'$D(^BWDIAG(IEN,0)) "UNKNOWN POINTER"
  1. Q $P(^BWDIAG(IEN,0),U)
  1. ;
  1. PRIOR() ;EP
  1. ;---> PROVIDE PRIORITY FOR THIS RESULT/DIAGNOSIS (DEFAULT=10).
  1. ;---> REQUIRED VARIABLE X=IEN IN BW RESULTS/DIAGNOSIS FILE.
  1. Q:'$D(X)!(X']"") 10
  1. Q:'$D(^BWDIAG(X,0)) 10
  1. Q:'$P(^BWDIAG(X,0),U,2) 10
  1. Q $P(^BWDIAG(X,0),U,2)
  1. ;
  1. NORMAL(X) ;EP
  1. ;---> PROVIDE NORMAL/ABNORMAL FOR THIS RESULT/DIAGNOSIS.
  1. ;---> WILL RETURN 0 IF NORMAL, 1 IF ABNORMAL (DEFAULT=1),
  1. ;---> 2 IF NO RESULT (EITHER THE PROCEDURE HAS NO RESULT OR
  1. ;---> THE RESULT/DIAGNOSIS HAS "NO RESULT" FOR FIELD #.21).
  1. ;---> REQUIRED VARIABLE X=IEN IN BW RESULTS/DIAGNOSIS FILE.
  1. Q:'$D(X)!(X']"") 2
  1. Q:'$D(^BWDIAG(X,0)) 2
  1. Q:$P(^BWDIAG(X,0),U,21)="" 2
  1. Q $P(^BWDIAG(X,0),U,21)
  1. ;
  1. COLP(DA) ;EP
  1. ;---> DETERMINE WHETHER OR NOT THE CURRENT PROCEDURE REQUIRES
  1. ;---> PAGE 2 OF PROCEDURE EDIT SCREENS FOR COLPOSCOPY RESULTS.
  1. ;---> RETURNS 1 IF COLP-TYPE RESULTS, OTHERWISE 0.
  1. ;---> DA=IEN OF PROCEDURE IN PROC FILE #9002086.1.
  1. N Y
  1. Q:'$G(DA) 0
  1. Q:'$D(^BWPCD(DA,0)) 0
  1. S Y=$P(^BWPCD(DA,0),U,4)
  1. Q:'Y 0
  1. Q:'$D(^BWPN(Y,0)) 0
  1. Q:$P(^BWPN(Y,0),U,3)<1 0
  1. Q 1
  1. ;
  1. COLPA(DA) ;EP
  1. ;---> LOOK FOR ASSOCIATED COLPOSCOPY, RETURN ITS ACC# AND DATE.
  1. N X,Y
  1. Q:'$G(DA) ""
  1. S Y=$$COLP0(DA)
  1. Q:Y="" "None"
  1. S X=$P(Y,U)_" on "_$$SLDT2^BWUTL5($P(Y,U,12))
  1. I $P(Y,U,5) Q X_"^"_$P(^BWDIAG($P(Y,U,5),0),U)
  1. Q X_"^"_"Not entered"
  1. ;
  1. COLP0(DA) ;EP
  1. ;---> IF THERE IS AN ASSOC'D COLP, RETURN ITS ZERO NODE.
  1. N Y
  1. Q:'$G(DA) ""
  1. Q:'$D(^BWPCD(DA,0)) ""
  1. Q:'$D(^BWPCD("ACOLP",DA)) ""
  1. S Y=$O(^BWPCD("ACOLP",DA,0)),Y=$O(^BWPCD("ACOLP",DA,Y,0))
  1. Q:'$D(^BWPCD(Y,0)) ""
  1. Q ^BWPCD(Y,0)
  1. ;
  1. MARGIN(DA) ;EP
  1. ;---> DETERMINE WHETHER THE "MARGINS CLEAR?" QUESTION (PAGE 2 OF
  1. ;---> PROCEDURE EDIT) SHOULD BE ASKED FOR THIS PROCEDURE.
  1. N Y
  1. Q:'$G(DA) 0
  1. Q:'$D(^BWPCD(DA,0)) 0
  1. S Y=$P(^BWPCD(DA,0),U,4)
  1. Q:'Y 0
  1. Q:'$D(^BWPN(Y,0)) 0
  1. Q:$P(^BWPN(Y,0),U,11)<1 0
  1. Q 1
  1. ;
  1. STAGE(STAGE) ;EP
  1. ;---> RETURN THE TEXT OF THE STAGE OF CARCINOMA.
  1. Q:'$G(STAGE) ""
  1. Q:'$D(^DD(9002086.1,.31,0)) "^DD MISSING"
  1. Q $P($P(^DD(9002086.1,.31,0),STAGE_":",2),";")
  1. HPVA(DA) ;
  1. ; ---> LOOK FOR ASSOCIATED HPV SCREENING, RETURN ITS ACC# AND DATE
  1. N X,Y
  1. Q:'$G(DA) ""
  1. S Y=$$HPVA0(DA)
  1. Q:Y="" "None"
  1. S X=$P(Y,U)_" on "_$$SLDT2^BWUTL5($P(Y,U,12))
  1. I $P(Y,U,5) Q X_"^"_$P(^BWDIAG($P(Y,U,5),0),U)
  1. Q X_"^"_"Not entered"
  1. HPVA0(DA) ;
  1. ;---> IF THERE IS AN ASSOC'D COLP, RETURN ITS ZERO NODE.
  1. N Y
  1. Q:'$G(DA) ""
  1. Q:'$D(^BWPCD(DA,0)) ""
  1. Q:'$D(^BWPCD("AHPV",DA)) ""
  1. S Y=$O(^BWPCD("AHPV",DA,0)),Y=$O(^BWPCD("AHPV",DA,Y,0))
  1. Q:'$D(^BWPCD(Y,0)) ""
  1. Q ^BWPCD(Y,0)