- 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 ;
