AMHLETPS ; IHS/CMI/LAB - SHARE TP ;
;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
;
;
EXIT ;
Q
EP ;EP
D FULL^VALM1
I '$D(^AMHSITE(DUZ(2),13,"B",DUZ)) W !,"You do not have access to share TP's" Q
;share
K DIR S DIR(0)="N^1:"_AMHRCNT_":0",DIR("A")="Select BH Treatment Plan" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) W !,"No treatment plan selected." Q
S AMHTPN=+Y I 'AMHTPN K AMHTP,VALMY,XQORNOD W !,"No treatment plan selected." Q
S AMHTP=$O(AMHPTP("IDX",AMHTPN,0)) I 'AMHTP K AMHTPDEL,AMHTP D PAUSE^AMHLETP1,EXIT Q
S AMHTP=AMHPTP("IDX",AMHTPN,AMHTP) I 'AMHTP K AMHTP D PAUSE^AMHLETP1,EXIT Q
I '$D(^AMHPTXP(AMHTP,0)) W !,"Not a valid TREATMENT PLAN." K AMHTPDEL,AMHTP D PAUSE^AMHLETP1,EXIT Q
S DFN=$P(^AMHPTXP(AMHTP,0),U,2)
D REGULAR
Q
REGULAR ;EP
S DIR(0)="Y",DIR("A")="Do you want to share this TREATMENT PLAN with other providers",DIR("B")="N" KILL DA D ^DIR KILL DIR
I $D(DIRUT) Q
I 'Y Q
K XMY D GETLIST
I '$D(XMY) G REGULAR
W !!,"Message will be sent to:" S X=0 F S X=$O(XMY(X)) Q:X'=+X W ?28,$P(^VA(200,X,0),U),!
S DIR(0)="Y",DIR("A")="Ready to send mail message",DIR("B")="Y" KILL DA D ^DIR KILL DIR
I $D(DIRUT) K XMY,XMTEXT,XMDUZ,XMZ,XMSUB,AMHEFT Q
I 'Y K XMY,XMTEXT,XMDUZ,XMZ,XMSUB G REGULAR
D MAILMSG
Q
GETLIST ;
K XMY
GETLIST1 ;
K DIC,DR,DD,D0,DO S DIC="^VA(200,",DIC(0)="AEMQ",DIC("A")="Send to: " D ^DIC
I Y=-1 Q
S XMY(+Y)=""
G GETLIST1
;
MAILMSG ;
S AMHBROW=1,AMHPREV="B"
K ^TMP("AMHLETPS",$J)
D GUIR^XBLM("PRINT^AMHLETPP","^TMP(""AMHLETPS"",$J,")
S (C,X)=0 F S X=$O(^TMP("AMHLETPS",$J,X)) Q:X'=+X S C=C+1
S C=C+1,^TMP("AMHLETPS",$J,C)="THIS MESSAGE CONTAINS CONFIDENTIAL PATIENT INFORMATION. UNAUTHORIZED"
S C=C+1,^TMP("AMHLETPS",$J,C)="REPRODUCTION OF THIS FORM MAY VIOLATE PRIVACY ACT STATUTES AND BE"
S C=C+1,^TMP("AMHLETPS",$J,C)="PUNISHABLE BY LAW."
S C=C+1,^TMP("AMHLETPS",$J,C)="*********** PLEASE DELETE IMMEDIATELY AFTER REVIEW. ***********"
S XMSUB="Patient Treatment Plan in Behavioral Health - CONFIDENTIAL"
S XMDUZ=$P(^VA(200,DUZ,0),U)
D XMZ^XMA2
S AMHXMZ=XMZ
S XMDUZ=$P(^VA(200,DUZ,0),U)
S XMTEXT="^TMP(""AMHLETPS"",$J,"
W !,"Sending Mailman message to distribution list"
D ENL^XMD
S XMZ=AMHXMZ
S DA=XMZ,DIE=3.9,DR="1.95///Y;1.96///Y" D ^DIE K DIE,DR,DA
D ENT1^XMD
KILL ^TMP("AMHLETPS",$J)
;set multiple imn record file
;kill vars
K XMZ,DA,DIE,DR,XMDUZ,AMHXMZ,AMHEFT,XMSUB,AMHX,XMY,AMHBROW,AMHPREV
W !,"Message Sent "
D PAUSE^AMHLETP1
Q
;
AMHLETPS ; IHS/CMI/LAB - SHARE TP ;
+1 ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
+2 ;
+3 ;
EXIT ;
+1 QUIT
EP ;EP
+1 DO FULL^VALM1
+2 IF '$DATA(^AMHSITE(DUZ(2),13,"B",DUZ))
WRITE !,"You do not have access to share TP's"
QUIT
+3 ;share
+4 KILL DIR
SET DIR(0)="N^1:"_AMHRCNT_":0"
SET DIR("A")="Select BH Treatment Plan"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+5 IF $DATA(DIRUT)
WRITE !,"No treatment plan selected."
QUIT
+6 SET AMHTPN=+Y
IF 'AMHTPN
KILL AMHTP,VALMY,XQORNOD
WRITE !,"No treatment plan selected."
QUIT
+7 SET AMHTP=$ORDER(AMHPTP("IDX",AMHTPN,0))
IF 'AMHTP
KILL AMHTPDEL,AMHTP
DO PAUSE^AMHLETP1
DO EXIT
QUIT
+8 SET AMHTP=AMHPTP("IDX",AMHTPN,AMHTP)
IF 'AMHTP
KILL AMHTP
DO PAUSE^AMHLETP1
DO EXIT
QUIT
+9 IF '$DATA(^AMHPTXP(AMHTP,0))
WRITE !,"Not a valid TREATMENT PLAN."
KILL AMHTPDEL,AMHTP
DO PAUSE^AMHLETP1
DO EXIT
QUIT
+10 SET DFN=$PIECE(^AMHPTXP(AMHTP,0),U,2)
+11 DO REGULAR
+12 QUIT
REGULAR ;EP
+1 SET DIR(0)="Y"
SET DIR("A")="Do you want to share this TREATMENT PLAN with other providers"
SET DIR("B")="N"
KILL DA
DO ^DIR
KILL DIR
+2 IF $DATA(DIRUT)
QUIT
+3 IF 'Y
QUIT
+4 KILL XMY
DO GETLIST
+5 IF '$DATA(XMY)
GOTO REGULAR
+6 WRITE !!,"Message will be sent to:"
SET X=0
FOR
SET X=$ORDER(XMY(X))
IF X'=+X
QUIT
WRITE ?28,$PIECE(^VA(200,X,0),U),!
+7 SET DIR(0)="Y"
SET DIR("A")="Ready to send mail message"
SET DIR("B")="Y"
KILL DA
DO ^DIR
KILL DIR
+8 IF $DATA(DIRUT)
KILL XMY,XMTEXT,XMDUZ,XMZ,XMSUB,AMHEFT
QUIT
+9 IF 'Y
KILL XMY,XMTEXT,XMDUZ,XMZ,XMSUB
GOTO REGULAR
+10 DO MAILMSG
+11 QUIT
GETLIST ;
+1 KILL XMY
GETLIST1 ;
+1 KILL DIC,DR,DD,D0,DO
SET DIC="^VA(200,"
SET DIC(0)="AEMQ"
SET DIC("A")="Send to: "
DO ^DIC
+2 IF Y=-1
QUIT
+3 SET XMY(+Y)=""
+4 GOTO GETLIST1
+5 ;
MAILMSG ;
+1 SET AMHBROW=1
SET AMHPREV="B"
+2 KILL ^TMP("AMHLETPS",$JOB)
+3 DO GUIR^XBLM("PRINT^AMHLETPP","^TMP(""AMHLETPS"",$J,")
+4 SET (C,X)=0
FOR
SET X=$ORDER(^TMP("AMHLETPS",$JOB,X))
IF X'=+X
QUIT
SET C=C+1
+5 SET C=C+1
SET ^TMP("AMHLETPS",$JOB,C)="THIS MESSAGE CONTAINS CONFIDENTIAL PATIENT INFORMATION. UNAUTHORIZED"
+6 SET C=C+1
SET ^TMP("AMHLETPS",$JOB,C)="REPRODUCTION OF THIS FORM MAY VIOLATE PRIVACY ACT STATUTES AND BE"
+7 SET C=C+1
SET ^TMP("AMHLETPS",$JOB,C)="PUNISHABLE BY LAW."
+8 SET C=C+1
SET ^TMP("AMHLETPS",$JOB,C)="*********** PLEASE DELETE IMMEDIATELY AFTER REVIEW. ***********"
+9 SET XMSUB="Patient Treatment Plan in Behavioral Health - CONFIDENTIAL"
+10 SET XMDUZ=$PIECE(^VA(200,DUZ,0),U)
+11 DO XMZ^XMA2
+12 SET AMHXMZ=XMZ
+13 SET XMDUZ=$PIECE(^VA(200,DUZ,0),U)
+14 SET XMTEXT="^TMP(""AMHLETPS"",$J,"
+15 WRITE !,"Sending Mailman message to distribution list"
+16 DO ENL^XMD
+17 SET XMZ=AMHXMZ
+18 SET DA=XMZ
SET DIE=3.9
SET DR="1.95///Y;1.96///Y"
DO ^DIE
KILL DIE,DR,DA
+19 DO ENT1^XMD
+20 KILL ^TMP("AMHLETPS",$JOB)
+21 ;set multiple imn record file
+22 ;kill vars
+23 KILL XMZ,DA,DIE,DR,XMDUZ,AMHXMZ,AMHEFT,XMSUB,AMHX,XMY,AMHBROW,AMHPREV
+24 WRITE !,"Message Sent "
+25 DO PAUSE^AMHLETP1
+26 QUIT
+27 ;
