- ORQQPL2 ; ALB/PDR/REV/TC - RPCs FOR CPRS GUI IMPLEMENTATION ;03/08/13 08:25
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,306,361**;Dec 17, 1997;Build 39
- ;
- ; External References:
- ; $$SITE^VASITE ICR #10112
- ; $$FMTE/$$HTFM/$$NOW^XLFDT ICR #10103
- ; $$GET^XPAR ICR #2263
- ; $$NAME^XUSER ICR #2343
- ;
- ; -------------- GET HISTORY FOR DETAIL DISPLAY ----------------------
- ;
- HIST(RETURN,GMPIFN) ; GET AUDIT HISTORY
- ; taken from EN^GMPLDISP
- N IDT,AIFN,S,ORDT,TXT,I,L,GMPDT,LCNT
- S LCNT=0
- I +$O(^GMPL(125.8,"AD",GMPIFN,0))'>0 D Q ;BAIL OUT - NO CHANGES
- . S RETURN(0)="NONE"
- ; get change history
- S IDT=""
- F S IDT=$O(^GMPL(125.8,"AD",GMPIFN,IDT)) Q:IDT'>0 D
- . S AIFN=""
- . F S AIFN=$O(^GMPL(125.8,"AD",GMPIFN,IDT,AIFN)) Q:AIFN'>0 D
- .. N FLD,GMPL0 S GMPL0=^GMPL(125.8,AIFN,0),FLD=$P(GMPL0,U,2)
- .. Q:(FLD=80201)!(FLD=80202)!(FLD=80002)
- .. D DT^GMPLHIST
- ; Transfer data and clean up for return to GUI
- S S="",I=0,TXT=""
- F S S=$O(GMPDT(S)) Q:S="" D
- . S L=GMPDT(S,0)
- . I $L(L,": ")>1 D Q ; does line begin with date? (hope ": " can't be part of text)
- .. D FLUSH(.RETURN,.I,$G(ORDT),$G(TXT))
- .. S ORDT=$P(L,": ") ; get new date
- .. S TXT=$$STRIP($P(L,": ",2,999)) ; start new text string
- . S TXT=TXT_" "_$$STRIP(L) ; line does not begin with date, so add to existing text line
- I '$D(RETURN(0)) S RETURN(0)=I
- D FLUSH(.RETURN,.I,$G(ORDT),$G(TXT))
- Q
- ;
- FLUSH(RETURN,I,ORDT,TXT) ; FLUSH FORMATTED AUDIT STRING
- I I'=0 D ; do we have a text string built?
- . S RETURN(I)=$$STRIP(ORDT)_U_TXT ; return date and text
- S I=I+1
- Q
- ;
- STRIP(VAL) ; STRIP LEADING SPACES FROM VALUES
- N J
- F J=1:1 Q:$E(VAL,J)'=" "
- Q $E(VAL,J,9999)
- ;
- ; ------------------- DELETE A PROBLEM FROM LIST ---------------------
- ;
- DELETE(RESULT,GMPIFN,GMPROV,GMPVAMC,REASON) ; DELETE A PROBLEM
- ; From GMPL1 - silent version
- N CHNGE
- I REASON'="" D
- . S GMPFLD(10,"NEW",1)=REASON
- . D NEWNOTE^GMPLSAVE
- S CHNGE=GMPIFN_"^1.02^"_$$HTFM^XLFDT($H)
- S CHNGE=CHNGE_U_DUZ_"^P^H^Deleted^"_+$G(GMPROV)
- S $P(^AUPNPROB(GMPIFN,1),U,2)="H"
- S RESULT=1
- D AUDIT^GMPLX(CHNGE,"")
- D DTMOD^GMPLX(GMPIFN)
- K GMPFLD
- Q
- ; ------------------ REPLACE REMOVED PROBLEM ----------------------
- ;
- REPLACE(RETURN,DA) ; -- replace problem on patient's list
- ; taken from REPLACE^GMPLRPTR
- N CHNGE,DIE,DR
- I $P($G(^AUPNPROB(DA,1)),U,2)'="H" D Q ; BAIL OUT - INVALID RECORD
- . S RETURN=0
- S DR="1.02////P"
- S DIE="^AUPNPROB("
- D ^DIE
- S CHNGE=DA_"^1.02^"_$$HTFM^XLFDT($H)_U_DUZ_"^H^P^Replaced^"_DUZ
- D AUDIT^GMPLX(CHNGE,"")
- D DTMOD^GMPLX(DA)
- S RETURN=1
- Q
- ;
- ; ------------------- VERIFY A PROBLEM ------------------------
- ;
- VERIFY(RETURN,GMPIFN) ; -- verify a transcribed problem
- ; RETURN: ;(consistent with UPDATE function)
- ; SUCCESS:
- ; RETURN>0, RETURN(0)=""
- ; FAILURE:
- ; RETURN<0, RETURN(0)=verbose error message
- N NOW,CHNGE
- S NOW=$$HTFM^XLFDT($H)
- I $P(^AUPNPROB(GMPIFN,1),U,2)'="T" D Q ; BAIL OUT - ALREADY VERIFIED
- . S RETURN=-1
- . S RETURN(0)="Problem Already Verified"
- L +^AUPNPROB(GMPIFN,0):10
- I '$T D Q ; BAIL OUT - NO LOCK
- . S RETURN=-1
- . S RETURN(0)="Record in use. Try again in a few moments"
- S $P(^AUPNPROB(GMPIFN,1),U,2)="P"
- S CHNGE=GMPIFN_"^1.02^"_NOW_U_DUZ_"^T^P^Verified^"_DUZ
- D AUDIT^GMPLX(CHNGE,"")
- D DTMOD^GMPLX(GMPIFN)
- L -^AUPNPROB(GMPIFN,0)
- S RETURN=1
- S RETURN(0)=""
- Q
- INACT(RETURN,GMPIFN) ; -- inactivate a problem
- ; RETURN: ;(consistent with UPDATE function)
- ; SUCCESS:
- ; RETURN>0, RETURN(0)=""
- ; FAILURE:
- ; RETURN<0, RETURN(0)=verbose error message
- N NOW,CHNGE
- S NOW=$$HTFM^XLFDT($H)
- I $P(^AUPNPROB(GMPIFN,0),U,12)'="A" D Q ; BAIL OUT - ALREADY INACTIVE
- . S RETURN=-1
- . S RETURN(0)="Problem Already Inactive"
- L +^AUPNPROB(GMPIFN,0):10
- I '$T D Q ; BAIL OUT - NO LOCK
- . S RETURN=-1
- . S RETURN(0)="Record in use. Try again in a few moments"
- S $P(^AUPNPROB(GMPIFN,0),U,12)="I"
- S CHNGE=GMPIFN_"^.12^"_NOW_U_DUZ_"^A^I^Inactivated^"_DUZ
- D AUDIT^GMPLX(CHNGE,"")
- D DTMOD^GMPLX(GMPIFN)
- L -^AUPNPROB(GMPIFN,0)
- S RETURN=1
- S RETURN(0)=""
- Q
- OLDCOMM(ORY,PIFN) ; Return comments for a problem - SINGLE DIVISION!
- ;N FAC,NIFN,NOTE,NOTECNT
- ;S NOTECNT=0
- ;S FAC=$O(^AUPNPROB(PIFN,11,"B",+$G(DUZ(2)),0)) Q:'FAC
- ;F NIFN=0:0 S NIFN=$O(^AUPNPROB(PIFN,11,FAC,11,"B",NIFN)) Q:NIFN'>0 D
- ;. Q:$P($G(^AUPNPROB(PIFN,11,FAC,11,NIFN,0)),U,4)'="A"
- ;. S NOTE=$P($G(^AUPNPROB(PIFN,11,FAC,11,NIFN,0)),U,3)
- ;. S NOTECNT=NOTECNT+1,ORY(NOTECNT)=NOTE
- Q
- GETCOMM(ORY,PIFN) ; Return comments for a problem - MULTI-DIVISIONAL
- N FAC,NIFN,NOTE,NOTECNT
- S NOTECNT=0,FAC=0
- F S FAC=$O(^AUPNPROB(PIFN,11,FAC)) Q:+FAC'>0 D
- . S NIFN=0
- . F S NIFN=$O(^AUPNPROB(PIFN,11,FAC,11,NIFN)) Q:NIFN'>0 D
- . . Q:$P($G(^AUPNPROB(PIFN,11,FAC,11,NIFN,0)),U,4)'="A"
- . . S NOTE=$P($G(^AUPNPROB(PIFN,11,FAC,11,NIFN,0)),U,3)
- . . S NOTECNT=NOTECNT+1,ORY(NOTECNT)=NOTE
- Q
- SAVEVIEW(Y,GMPLVIEW) ; -- save new view in File #200/Field #125
- N TMP
- Q:'$D(GMPLVIEW)
- S TMP=$P($G(^VA(200,DUZ,125)),U,2,999)
- S ^VA(200,DUZ,125)=$P(GMPLVIEW,U,1)_U_TMP
- S TMP=$$GET^XPAR(DUZ_";VA(200,","ORCH CONTEXT PROBLEMS",1)
- I TMP'="" D Q
- . D CHG^XPAR(DUZ_";VA(200,","ORCH CONTEXT PROBLEMS",1,$P(GMPLVIEW,U,2))
- D ADD^XPAR(DUZ_";VA(200,","ORCH CONTEXT PROBLEMS",1,$P(GMPLVIEW,U,2))
- Q
- NTRTBULL(ORY,ORTERM,ORNP,ORPT,ORCOMM) ; Send NTRT Request bulletin to CAC mailgroup
- N ORSITE,ORSVC,ORUSER,OREQSTR,OREQSVC,ORDGRP,XMB,XMDUZ,XMY
- D USERINFO^XUSRB2(.ORUSER) S ORSITE=$G(ORUSER(3)),ORSVC=$G(ORUSER(5))
- S OREQSTR=$S(DUZ'=ORNP:ORUSER(2)_" for "_$$NAME^XUSER(ORNP),1:ORUSER(2))
- S OREQSVC=$P($$SERVICE^GMPLX1(ORNP,1),U,2)
- S ORSVC=$S(ORSVC=OREQSVC:ORSVC,1:ORSVC_"/"_OREQSVC)
- S:ORSITE']"" ORSITE=$$SITE^VASITE
- I '$L(ORTERM) S ORY="0^Empty String - a valid term must be sent." Q
- I '+$G(DUZ)!'$D(^VA(200,+$G(DUZ))) S ORY="0^A valid user must be identified." Q
- S XMB="OR PROBLEM NTRT BULLETIN"
- S XMDUZ="OR PROBLEM NTRT BULLETIN"
- ; Recipients = g.OR CACS [defined in BULLETIN File entry] &
- ; [Divisional mail group defined in OR PROBLEM NTRT BY DIVISION param]
- S ORDGRP=$$GET^XPAR("DIV.`"_DUZ(2),"OR PROBLEM NTRT BY DIVISION",1,"E")
- S:ORDGRP]"" XMY("G."_ORDGRP)=""
- S XMB(1)=ORTERM
- S XMB(2)=$$FMTE^XLFDT($E(($$NOW^XLFDT),1,12),2)
- S XMB(3)=OREQSTR
- S XMB(4)=ORSVC
- S XMB(5)=$P(ORSITE,U,2)_"("_$P(ORSITE,U,3)_")"
- S XMB(6)=$G(ORPT,"")
- S XMB(7)=$G(ORCOMM,"None")
- D ^XMB,KILL^XM S ORY=1
- Q
- TESTBULL ; Test setting up and sending PL NTRT bulletin
- N ORY
- D NTRTBULL(.ORY,"PL NTRT Test!")
- W !,"Call Result: ",$S(+ORY:"Success!",1:$P(ORY,U,2))
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORQQPL2 6735 printed Jan 18, 2025@03:34:50 Page 2
- ORQQPL2 ; ALB/PDR/REV/TC - RPCs FOR CPRS GUI IMPLEMENTATION ;03/08/13 08:25
- +1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,306,361**;Dec 17, 1997;Build 39
- +2 ;
- +3 ; External References:
- +4 ; $$SITE^VASITE ICR #10112
- +5 ; $$FMTE/$$HTFM/$$NOW^XLFDT ICR #10103
- +6 ; $$GET^XPAR ICR #2263
- +7 ; $$NAME^XUSER ICR #2343
- +8 ;
- +9 ; -------------- GET HISTORY FOR DETAIL DISPLAY ----------------------
- +10 ;
- HIST(RETURN,GMPIFN) ; GET AUDIT HISTORY
- +1 ; taken from EN^GMPLDISP
- +2 NEW IDT,AIFN,S,ORDT,TXT,I,L,GMPDT,LCNT
- +3 SET LCNT=0
- +4 ;BAIL OUT - NO CHANGES
- IF +$ORDER(^GMPL(125.8,"AD",GMPIFN,0))'>0
- Begin DoDot:1
- +5 SET RETURN(0)="NONE"
- End DoDot:1
- QUIT
- +6 ; get change history
- +7 SET IDT=""
- +8 FOR
- SET IDT=$ORDER(^GMPL(125.8,"AD",GMPIFN,IDT))
- if IDT'>0
- QUIT
- Begin DoDot:1
- +9 SET AIFN=""
- +10 FOR
- SET AIFN=$ORDER(^GMPL(125.8,"AD",GMPIFN,IDT,AIFN))
- if AIFN'>0
- QUIT
- Begin DoDot:2
- +11 NEW FLD,GMPL0
- SET GMPL0=^GMPL(125.8,AIFN,0)
- SET FLD=$PIECE(GMPL0,U,2)
- +12 if (FLD=80201)!(FLD=80202)!(FLD=80002)
- QUIT
- +13 DO DT^GMPLHIST
- End DoDot:2
- End DoDot:1
- +14 ; Transfer data and clean up for return to GUI
- +15 SET S=""
- SET I=0
- SET TXT=""
- +16 FOR
- SET S=$ORDER(GMPDT(S))
- if S=""
- QUIT
- Begin DoDot:1
- +17 SET L=GMPDT(S,0)
- +18 ; does line begin with date? (hope ": " can't be part of text)
- IF $LENGTH(L,": ")>1
- Begin DoDot:2
- +19 DO FLUSH(.RETURN,.I,$GET(ORDT),$GET(TXT))
- +20 ; get new date
- SET ORDT=$PIECE(L,": ")
- +21 ; start new text string
- SET TXT=$$STRIP($PIECE(L,": ",2,999))
- End DoDot:2
- QUIT
- +22 ; line does not begin with date, so add to existing text line
- SET TXT=TXT_" "_$$STRIP(L)
- End DoDot:1
- +23 IF '$DATA(RETURN(0))
- SET RETURN(0)=I
- +24 DO FLUSH(.RETURN,.I,$GET(ORDT),$GET(TXT))
- +25 QUIT
- +26 ;
- FLUSH(RETURN,I,ORDT,TXT) ; FLUSH FORMATTED AUDIT STRING
- +1 ; do we have a text string built?
- IF I'=0
- Begin DoDot:1
- +2 ; return date and text
- SET RETURN(I)=$$STRIP(ORDT)_U_TXT
- End DoDot:1
- +3 SET I=I+1
- +4 QUIT
- +5 ;
- STRIP(VAL) ; STRIP LEADING SPACES FROM VALUES
- +1 NEW J
- +2 FOR J=1:1
- if $EXTRACT(VAL,J)'=" "
- QUIT
- +3 QUIT $EXTRACT(VAL,J,9999)
- +4 ;
- +5 ; ------------------- DELETE A PROBLEM FROM LIST ---------------------
- +6 ;
- DELETE(RESULT,GMPIFN,GMPROV,GMPVAMC,REASON) ; DELETE A PROBLEM
- +1 ; From GMPL1 - silent version
- +2 NEW CHNGE
- +3 IF REASON'=""
- Begin DoDot:1
- +4 SET GMPFLD(10,"NEW",1)=REASON
- +5 DO NEWNOTE^GMPLSAVE
- End DoDot:1
- +6 SET CHNGE=GMPIFN_"^1.02^"_$$HTFM^XLFDT($HOROLOG)
- +7 SET CHNGE=CHNGE_U_DUZ_"^P^H^Deleted^"_+$GET(GMPROV)
- +8 SET $PIECE(^AUPNPROB(GMPIFN,1),U,2)="H"
- +9 SET RESULT=1
- +10 DO AUDIT^GMPLX(CHNGE,"")
- +11 DO DTMOD^GMPLX(GMPIFN)
- +12 KILL GMPFLD
- +13 QUIT
- +14 ; ------------------ REPLACE REMOVED PROBLEM ----------------------
- +15 ;
- REPLACE(RETURN,DA) ; -- replace problem on patient's list
- +1 ; taken from REPLACE^GMPLRPTR
- +2 NEW CHNGE,DIE,DR
- +3 ; BAIL OUT - INVALID RECORD
- IF $PIECE($GET(^AUPNPROB(DA,1)),U,2)'="H"
- Begin DoDot:1
- +4 SET RETURN=0
- End DoDot:1
- QUIT
- +5 SET DR="1.02////P"
- +6 SET DIE="^AUPNPROB("
- +7 DO ^DIE
- +8 SET CHNGE=DA_"^1.02^"_$$HTFM^XLFDT($HOROLOG)_U_DUZ_"^H^P^Replaced^"_DUZ
- +9 DO AUDIT^GMPLX(CHNGE,"")
- +10 DO DTMOD^GMPLX(DA)
- +11 SET RETURN=1
- +12 QUIT
- +13 ;
- +14 ; ------------------- VERIFY A PROBLEM ------------------------
- +15 ;
- VERIFY(RETURN,GMPIFN) ; -- verify a transcribed problem
- +1 ; RETURN: ;(consistent with UPDATE function)
- +2 ; SUCCESS:
- +3 ; RETURN>0, RETURN(0)=""
- +4 ; FAILURE:
- +5 ; RETURN<0, RETURN(0)=verbose error message
- +6 NEW NOW,CHNGE
- +7 SET NOW=$$HTFM^XLFDT($HOROLOG)
- +8 ; BAIL OUT - ALREADY VERIFIED
- IF $PIECE(^AUPNPROB(GMPIFN,1),U,2)'="T"
- Begin DoDot:1
- +9 SET RETURN=-1
- +10 SET RETURN(0)="Problem Already Verified"
- End DoDot:1
- QUIT
- +11 LOCK +^AUPNPROB(GMPIFN,0):10
- +12 ; BAIL OUT - NO LOCK
- IF '$TEST
- Begin DoDot:1
- +13 SET RETURN=-1
- +14 SET RETURN(0)="Record in use. Try again in a few moments"
- End DoDot:1
- QUIT
- +15 SET $PIECE(^AUPNPROB(GMPIFN,1),U,2)="P"
- +16 SET CHNGE=GMPIFN_"^1.02^"_NOW_U_DUZ_"^T^P^Verified^"_DUZ
- +17 DO AUDIT^GMPLX(CHNGE,"")
- +18 DO DTMOD^GMPLX(GMPIFN)
- +19 LOCK -^AUPNPROB(GMPIFN,0)
- +20 SET RETURN=1
- +21 SET RETURN(0)=""
- +22 QUIT
- INACT(RETURN,GMPIFN) ; -- inactivate a problem
- +1 ; RETURN: ;(consistent with UPDATE function)
- +2 ; SUCCESS:
- +3 ; RETURN>0, RETURN(0)=""
- +4 ; FAILURE:
- +5 ; RETURN<0, RETURN(0)=verbose error message
- +6 NEW NOW,CHNGE
- +7 SET NOW=$$HTFM^XLFDT($HOROLOG)
- +8 ; BAIL OUT - ALREADY INACTIVE
- IF $PIECE(^AUPNPROB(GMPIFN,0),U,12)'="A"
- Begin DoDot:1
- +9 SET RETURN=-1
- +10 SET RETURN(0)="Problem Already Inactive"
- End DoDot:1
- QUIT
- +11 LOCK +^AUPNPROB(GMPIFN,0):10
- +12 ; BAIL OUT - NO LOCK
- IF '$TEST
- Begin DoDot:1
- +13 SET RETURN=-1
- +14 SET RETURN(0)="Record in use. Try again in a few moments"
- End DoDot:1
- QUIT
- +15 SET $PIECE(^AUPNPROB(GMPIFN,0),U,12)="I"
- +16 SET CHNGE=GMPIFN_"^.12^"_NOW_U_DUZ_"^A^I^Inactivated^"_DUZ
- +17 DO AUDIT^GMPLX(CHNGE,"")
- +18 DO DTMOD^GMPLX(GMPIFN)
- +19 LOCK -^AUPNPROB(GMPIFN,0)
- +20 SET RETURN=1
- +21 SET RETURN(0)=""
- +22 QUIT
- OLDCOMM(ORY,PIFN) ; Return comments for a problem - SINGLE DIVISION!
- +1 ;N FAC,NIFN,NOTE,NOTECNT
- +2 ;S NOTECNT=0
- +3 ;S FAC=$O(^AUPNPROB(PIFN,11,"B",+$G(DUZ(2)),0)) Q:'FAC
- +4 ;F NIFN=0:0 S NIFN=$O(^AUPNPROB(PIFN,11,FAC,11,"B",NIFN)) Q:NIFN'>0 D
- +5 ;. Q:$P($G(^AUPNPROB(PIFN,11,FAC,11,NIFN,0)),U,4)'="A"
- +6 ;. S NOTE=$P($G(^AUPNPROB(PIFN,11,FAC,11,NIFN,0)),U,3)
- +7 ;. S NOTECNT=NOTECNT+1,ORY(NOTECNT)=NOTE
- +8 QUIT
- GETCOMM(ORY,PIFN) ; Return comments for a problem - MULTI-DIVISIONAL
- +1 NEW FAC,NIFN,NOTE,NOTECNT
- +2 SET NOTECNT=0
- SET FAC=0
- +3 FOR
- SET FAC=$ORDER(^AUPNPROB(PIFN,11,FAC))
- if +FAC'>0
- QUIT
- Begin DoDot:1
- +4 SET NIFN=0
- +5 FOR
- SET NIFN=$ORDER(^AUPNPROB(PIFN,11,FAC,11,NIFN))
- if NIFN'>0
- QUIT
- Begin DoDot:2
- +6 if $PIECE($GET(^AUPNPROB(PIFN,11,FAC,11,NIFN,0)),U,4)'="A"
- QUIT
- +7 SET NOTE=$PIECE($GET(^AUPNPROB(PIFN,11,FAC,11,NIFN,0)),U,3)
- +8 SET NOTECNT=NOTECNT+1
- SET ORY(NOTECNT)=NOTE
- End DoDot:2
- End DoDot:1
- +9 QUIT
- SAVEVIEW(Y,GMPLVIEW) ; -- save new view in File #200/Field #125
- +1 NEW TMP
- +2 if '$DATA(GMPLVIEW)
- QUIT
- +3 SET TMP=$PIECE($GET(^VA(200,DUZ,125)),U,2,999)
- +4 SET ^VA(200,DUZ,125)=$PIECE(GMPLVIEW,U,1)_U_TMP
- +5 SET TMP=$$GET^XPAR(DUZ_";VA(200,","ORCH CONTEXT PROBLEMS",1)
- +6 IF TMP'=""
- Begin DoDot:1
- +7 DO CHG^XPAR(DUZ_";VA(200,","ORCH CONTEXT PROBLEMS",1,$PIECE(GMPLVIEW,U,2))
- End DoDot:1
- QUIT
- +8 DO ADD^XPAR(DUZ_";VA(200,","ORCH CONTEXT PROBLEMS",1,$PIECE(GMPLVIEW,U,2))
- +9 QUIT
- NTRTBULL(ORY,ORTERM,ORNP,ORPT,ORCOMM) ; Send NTRT Request bulletin to CAC mailgroup
- +1 NEW ORSITE,ORSVC,ORUSER,OREQSTR,OREQSVC,ORDGRP,XMB,XMDUZ,XMY
- +2 DO USERINFO^XUSRB2(.ORUSER)
- SET ORSITE=$GET(ORUSER(3))
- SET ORSVC=$GET(ORUSER(5))
- +3 SET OREQSTR=$SELECT(DUZ'=ORNP:ORUSER(2)_" for "_$$NAME^XUSER(ORNP),1:ORUSER(2))
- +4 SET OREQSVC=$PIECE($$SERVICE^GMPLX1(ORNP,1),U,2)
- +5 SET ORSVC=$SELECT(ORSVC=OREQSVC:ORSVC,1:ORSVC_"/"_OREQSVC)
- +6 if ORSITE']""
- SET ORSITE=$$SITE^VASITE
- +7 IF '$LENGTH(ORTERM)
- SET ORY="0^Empty String - a valid term must be sent."
- QUIT
- +8 IF '+$GET(DUZ)!'$DATA(^VA(200,+$GET(DUZ)))
- SET ORY="0^A valid user must be identified."
- QUIT
- +9 SET XMB="OR PROBLEM NTRT BULLETIN"
- +10 SET XMDUZ="OR PROBLEM NTRT BULLETIN"
- +11 ; Recipients = g.OR CACS [defined in BULLETIN File entry] &
- +12 ; [Divisional mail group defined in OR PROBLEM NTRT BY DIVISION param]
- +13 SET ORDGRP=$$GET^XPAR("DIV.`"_DUZ(2),"OR PROBLEM NTRT BY DIVISION",1,"E")
- +14 if ORDGRP]""
- SET XMY("G."_ORDGRP)=""
- +15 SET XMB(1)=ORTERM
- +16 SET XMB(2)=$$FMTE^XLFDT($EXTRACT(($$NOW^XLFDT),1,12),2)
- +17 SET XMB(3)=OREQSTR
- +18 SET XMB(4)=ORSVC
- +19 SET XMB(5)=$PIECE(ORSITE,U,2)_"("_$PIECE(ORSITE,U,3)_")"
- +20 SET XMB(6)=$GET(ORPT,"")
- +21 SET XMB(7)=$GET(ORCOMM,"None")
- +22 DO ^XMB
- DO KILL^XM
- SET ORY=1
- +23 QUIT
- TESTBULL ; Test setting up and sending PL NTRT bulletin
- +1 NEW ORY
- +2 DO NTRTBULL(.ORY,"PL NTRT Test!")
- +3 WRITE !,"Call Result: ",$SELECT(+ORY:"Success!",1:$PIECE(ORY,U,2))
- +4 QUIT