LRWOMEN ;DALOI/CYM/FT/CKA - LINK TO WOMEN'S HEALTH PROGRAM ;10/22/04 13:14
;;5.2;LAB SERVICE;**231,248,311,324,365**;Sep 27, 1994;Build 9
;
;Reference to CREATE^WVLRLINK supported by IA #2772
;Reference to DELETE^WVLRLINK supported by IA #2772
;Reference to CREATE^WVLABCHK supported by IA #4525
;
ADD ; From DD 63.08,.11 and 63.09,.11
Q:+$G(LRDPF)'=2
Q:'$D(LRSS)
Q:$P(^LR(LRDFN,LRSS,LRI,0),U,11)']""
Q:$G(SEX)'["F"
Q:$T(CREATE^WVLRLINK)']""
D CREATE^WVLRLINK(DFN,LRDFN,LRI,$G(LRA),LRSS)
Q
;
;
DEL ; From LRAPM
Q:$G(SEX)'["F"
Q:+$G(LRDPF)'=2
Q:'$D(LRSS)
Q:$P(^LR(LRDFN,LRSS,LRI,0),U,11)]""
Q:$T(DELETE^WVLRLINK)']""
D DELETE^WVLRLINK(DFN,LRDFN,LRI,X,LRSS)
Q
;
;
MOVE ; From LRAPMV
; no longer used after LR*5.2*259
Q
;
;
SNOMED ; From DD 63.08,10 and 63.09,10
Q:+$G(LRDPF)'=2
Q:'$D(LRSS)
Q:$P(^LR(LRDFN,LRSS,LRI,0),U,11)=""
Q:$G(SEX)'["F"
Q:$T(CREATE^WVLABCHK)']""
D CREATE^WVLABCHK(DFN,LRDFN,LRI,$G(LRA),LRSS)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRWOMEN 989 printed Dec 13, 2024@02:23:08 Page 2
LRWOMEN ;DALOI/CYM/FT/CKA - LINK TO WOMEN'S HEALTH PROGRAM ;10/22/04 13:14
+1 ;;5.2;LAB SERVICE;**231,248,311,324,365**;Sep 27, 1994;Build 9
+2 ;
+3 ;Reference to CREATE^WVLRLINK supported by IA #2772
+4 ;Reference to DELETE^WVLRLINK supported by IA #2772
+5 ;Reference to CREATE^WVLABCHK supported by IA #4525
+6 ;
ADD ; From DD 63.08,.11 and 63.09,.11
+1 if +$GET(LRDPF)'=2
QUIT
+2 if '$DATA(LRSS)
QUIT
+3 if $PIECE(^LR(LRDFN,LRSS,LRI,0),U,11)']""
QUIT
+4 if $GET(SEX)'["F"
QUIT
+5 if $TEXT(CREATE^WVLRLINK)']""
QUIT
+6 DO CREATE^WVLRLINK(DFN,LRDFN,LRI,$GET(LRA),LRSS)
+7 QUIT
+8 ;
+9 ;
DEL ; From LRAPM
+1 if $GET(SEX)'["F"
QUIT
+2 if +$GET(LRDPF)'=2
QUIT
+3 if '$DATA(LRSS)
QUIT
+4 if $PIECE(^LR(LRDFN,LRSS,LRI,0),U,11)]""
QUIT
+5 if $TEXT(DELETE^WVLRLINK)']""
QUIT
+6 DO DELETE^WVLRLINK(DFN,LRDFN,LRI,X,LRSS)
+7 QUIT
+8 ;
+9 ;
MOVE ; From LRAPMV
+1 ; no longer used after LR*5.2*259
+2 QUIT
+3 ;
+4 ;
SNOMED ; From DD 63.08,10 and 63.09,10
+1 if +$GET(LRDPF)'=2
QUIT
+2 if '$DATA(LRSS)
QUIT
+3 if $PIECE(^LR(LRDFN,LRSS,LRI,0),U,11)=""
QUIT
+4 if $GET(SEX)'["F"
QUIT
+5 if $TEXT(CREATE^WVLABCHK)']""
QUIT
+6 DO CREATE^WVLABCHK(DFN,LRDFN,LRI,$GET(LRA),LRSS)
+7 QUIT
