Changeset 623 for WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- Location:
- WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT
- Files:
-
- 14 edited
-
YS31ENV.m (modified) (1 diff)
-
YS31POST.m (modified) (1 diff)
-
YSCLSERV.m (modified) (1 diff)
-
YSCLSRV2.m (modified) (1 diff)
-
YSCLSRV3.m (modified) (1 diff)
-
YSCLTST2.m (modified) (1 diff)
-
YTALUSE.m (modified) (1 diff)
-
YTAPI5.m (modified) (1 diff)
-
YTAUIRR.m (modified) (1 diff)
-
YTDOMR.m (modified) (1 diff)
-
YTDOMR1.m (modified) (1 diff)
-
YTKIL.m (modified) (1 diff)
-
YTMMPI2B.m (modified) (1 diff)
-
YTPCL.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YS31ENV.m
r613 r623 1 YS31ENV 2 3 EN 4 5 6 7 8 EXIT 9 10 11 12 13 CHECK 14 15 16 17 18 19 20 21 EOR 1 YS31ENV ;DALCIOFO/MJD-YS*5.01*31 PATCH ENVIRONMENT CHECK ROUTINE ;10/30/97 2 ;;5.01;MENTAL HEALTH;**31**;Dec 30, 1994 3 EN ; Does not prevent loading of the transport global. 4 ;Environment check is done only during the install. 5 QUIT:'$G(XPDENV) 6 D CHECK 7 ; 8 EXIT I $G(XPDQUIT) W !!,$$CJ^XLFSTR("Install Environment Check FAILED",80) 9 I '$G(XPDQUIT) W !!,$$CJ^XLFSTR("Environment Check is Done...",80) 10 K VER,RN,LN2 11 QUIT 12 ; 13 CHECK ; 14 I $S('$G(IOM):1,'$G(IOSL):1,$G(U)'="^":1,1:0) W !,$$CJ^XLFSTR("Terminal Device is not defined",80),!! S XPDQUIT=2 Q 15 I $S('$G(DUZ):1,$D(DUZ)[0:1,$D(DUZ(0))[0:1,1:0) W !!,$$CJ^XLFSTR("Please Log in to set local DUZ... variables",80),! S XPDQUIT=2 Q 16 I '$D(^VA(200,$G(DUZ),0))#2 W !,$$CJ^XLFSTR("You are not a valid user on this system",80),! S XPDQUIT=2 Q 17 S VER=$$VERSION^XPDUTL("MENTAL HEALTH") 18 I VER'=5.01 W !,$$CJ^XLFSTR("You must have Mental Health V 5.01 Installed",80),! S XPDQUIT=2 Q 19 QUIT 20 ; 21 EOR ;;YS*5.01*31 PATCH ENVIRONMENT CHECK ROUTINE;; -
WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YS31POST.m
r613 r623 1 YS31POST 2 3 4 5 6 7 8 9 10 1 YS31POST ;DALCIOFO/MJD-PATCH YS*5.01*31 POST RTN. ;09/23/97 2 ;;5.01;MENTAL HEALTH;**31**;Dec 30, 1994 3 ; 4 ; Unless the site has modified this file the zero node 5 ; for file #601 MH INSTRUMENT should look like: 6 ; ^YTT(601,0) = MH INSTRUMENT^601^233^88 7 S:$P(^YTT(601,0),U,3)="225" $P(^YTT(601,0),U,3)=233 8 S $P(^YTT(601,0),U,4)=$P(^YTT(601,0),U,4)+8 9 ; 10 QUIT -
WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSCLSERV.m
r613 r623 1 YSCLSERV ;DALOI/RLM-Clozapine data server ;24 APR 1990 2 ;;5.01;MENTAL HEALTH;**18,22,26,47,61,69,74,90,92**;Dec 30, 1994;Build 7 3 ; Reference to ^%ZOSF supported by IA #10096 4 ; Reference to ^DPT supported by IA #10035 5 ; Reference to ^DD("DD" supported by IA #10017 6 ; Reference to ^PS(55 supported by IA #787 7 ; Reference to ^PSDRUG supported by IA #25 8 ; Reference to ^PSRX supported by IA #780 9 ; Reference to ^VA(200 supported by IA #10060 10 ; Reference to $$SITE^VASITE supported by IA #10112 11 ; Reference to $$FMTE^XLFDT() supported by IA #10103 12 ; Reference to ^PSDRUG supported by IA #221 13 ; Reference to ^XMD supported by IA #10070 14 START ; 15 K ^TMP($J,"YSCLDATA") 16 S YSDEBUG=$P(^YSCL(603.03,1,0),"^",3) 17 S YSCLST=$P($$SITE^VASITE,"^",3) 18 S YSCLSTN=$P($$SITE^VASITE,"^",2) 19 ;Determine station number 20 S X=XQSUB X ^%ZOSF("UPPERCASE") S YSCLSUB=Y 21 S ^TMP($J,"YSCLDATA",1)=$S(YSDEBUG:"DEBUG ",1:"")_YSCLSUB_" triggered at "_YSCLST_" by "_XMFROM_" on "_XQDATE 22 ;The first line of the message tells who requested the action and when 23 D 24 . S YSACTION=$S(YSCLSUB["REMOVE"!(YSCLSUB["DELETE"):"data deleted",YSCLSUB["REPORT":"report generated",YSCLSUB["REBUILD":"data verified",YSCLSUB["UPDATE":"data updated",YSCLSUB["DATESET":"date set",1:"CONT") 25 . I YSACTION="CONT" S YSACTION=$S(YSCLSUB["DEMOG RESET":"Demographics Flag Reset",YSCLSUB["DEBUG":"Debug Mode set",YSCLSUB["AUTH":"Authorization",YSCLSUB["LOCK":"Lock",1:"Site Lock") 26 . S ^TMP($J,"YSCLDATA",2)="No "_$S(YSDEBUG:"DEBUG ",1:"")_YSACTION_" at "_YSCLST 27 ;The second line tells when the server is activated and no data can be 28 ;gathered from the MailMan message. This line gets replaced if the 29 ;server finds something to do. 30 S YSCLLNT=1 I YSCLSUB["REMOVE"!(YSCLSUB["DELETE") G DELETE 31 ;If the subject contains the word REMOVE or DELETE delete those entries from the list. 32 I YSCLSUB["REPORT" G REPORT 33 ;If the subject contains "REPORT" send a report of the currently registered patients to the Clozapine group on Forum 34 ;I YSCLSUB["REBUILD" G REBUILD 35 I YSCLSUB["RESEND" G RESEND 36 I YSCLSUB["UPDATE" G UPDATE 37 ;I YSCLSUB["CHECKSUM" G CSUM^YSCLSRV1 38 I YSCLSUB["DATESET" G DSET 39 I YSCLSUB["DEBUG" G DEBUG 40 I YSCLSUB["PATIENT" G ^YSCLSRV3 41 I YSCLSUB["LOCKOUT" G LOCK^YSCLSRV3 42 I YSCLSUB="DEMOG RESET" G DEMOG^YSCLSRV3 43 I YSCLSUB["AUTHORIZE" G AUTH^YSCLSRV3 44 I YSCLSUB="OVERRIDE" G OVRRID^YSCLSRV2 45 I YSCLSUB="CLAPI" G CLAPI^YSCLSRV2 46 I YSCLSUB="CL1API" G CL1API^YSCLSRV2 47 I YSCLSUB["DISCON" G DCON^YSCLSRV2 48 F X XMREC Q:XMER<0 S XMRG=$TR(XMRG,"- ","") D 49 . ;Verify that + of site number matches local site number 50 . I XMRG'?2U5N1","9N1","1U S YSCLER=" is in error and was not added at " D OUT Q 51 . I $P(XMRG,",")'?2U5N S YSCLER=" is not a valid Clozapine number " D OUT Q 52 . I $P(XMRG,",",2)'?9N S YSCLER=" An SSN must be 9 numbers " D OUT Q 53 . I $P(XMRG,",",3)'="B",$P(XMRG,",",3)'="W",$P(XMRG,",",3)'="M" S YSCLER=" You must specify Weekly, Biweekly, or Monthly " D OUT Q 54 . ;Validate the format of the data in the message and report the error. 55 . S DIC="^DPT(",DIC(0)="X",D="SSN",X=$P(XMRG,",",2) I '$D(^DPT("SSN",X)) S YSCLER=" SSN does not exist at " D OUT Q 56 . ;Do not add data for records where the SSN sent is not in the local database 57 . I $D(^YSCL(603.01,"B",$P(XMRG,","))) S YSCLX=$O(^YSCL(603.01,"B",$P(XMRG,","),"")) S:YSCLX]"" YSCLX=$P(^YSCL(603.01,YSCLX,0),"^",2),YSCLER=" Clozapine # is in use by "_$P($G(^DPT(YSCLX,0)),"^")_" at " D OUT Q 58 . D MIX^DIC1 S YSCLPT=+Y I Y=-1 S YSCLER=" could not be added at " D OUT Q 59 . ;Add the data and report any errors to the Roll-Up group at Forum. 60 . K DD S DIC="^YSCL(603.01,",X=$P(XMRG,","),DIC("DR")="1////"_YSCLPT_";2////"_$P(XMRG,",",3) K DO D FILE^DICN 61 . S YSCLX=$O(^YSCL(603.01,"B",$P(XMRG,","),"")) S:YSCLX]"" YSCLX=$P(^YSCL(603.01,YSCLX,0),"^",2),YSCLER=" assigned to "_$P($G(^DPT(YSCLX,0)),"^")_" at " D OUT 62 EXIT ;If all went well, report that too. 63 S YSDEBUG=$P(^YSCL(603.03,1,0),"^",3) 64 S %H=$H D YMD^%DTC S XMDUN="NCCC LOGGER",XMDUZ=".5",XMSUB=$S(YSDEBUG:"DEBUG ",YSCLSUB["DEBUG":"DEBUG ",1:"")_YSCLST_" NCCC ENROLLER ("_X_%_")",XMTEXT="^TMP($J,""YSCLDATA""," 65 K XMY S XMY("G.CLOZAPINE ROLL-UP@FORUM.VA.GOV")="" 66 I YSDEBUG!(YSCLSUB["DEBUG") S XMY("G.CLOZAPINE DEBUG@FO-DALLAS.MED.VA.GOV")="" 67 D ^XMD 68 ;Mail the errors and successes back to the Roll-Up group at Forum. 69 K ^TMP($J,"YSCLDATA") 70 K %,%DT,%H,D,DA,DD,DIC,DIE,DIK,RET,X,XMDUN,XMDUZ,XMER,XMFROM 71 K XMREC,XMRG,XMSUB,XMTEXT,XMY,XMZ,XQDATE,XQSUB,Y,YSA,YSACTION,YSCLTYPE 72 K YSCL28,YSCLA,YSCLAA,YSCLB,YSCLC,YSCLDA,YSCLDA1,YSCLDATA,YSCLDEA1 73 K YSCLDFN,YSCLDM,YSCLDOC,YSCLDOM,YSCLDR,YSCLDRA,YSCLDRB,YSCLDTA,YSCLERR 74 K YSCLDUZ,YSCLED,YSCLER,YSCLFDA,YSCLFRQ,YSCLLNT,YSCLNM,YSCLOVR,YSCLSITE 75 K YSCLPT,YSCLRPT,YSCLSD1,YSCLSDT,YSCLSSN,YSCLST,YSCLSTN,YSCLSUB,YSCLTC 76 K YSCLRX,YSCLSAND,YSCLWB,YSCLX,YSCLYN,YSDEBUG,YSI,YSOFF,YSPR,ZTQUEUED,ZTSK 77 Q 78 DELETE ;Allow the NCCC users to delete clozapine registration at the individual sites 79 S YSCLLNT=1 F X XMREC Q:XMER<0 S XMRG=$TR(XMRG,"- ","") D 80 . I XMRG="**++**DELETEALL**++**" D DELALL Q 81 . I '$D(^YSCL(603.01,"B",$P(XMRG,","))) S YSCLER=" "_$P(XMRG,",")_" is not registered at " D OUT Q 82 . S YSCLDFN=$O(^DPT("SSN",$P(XMRG,",",2),"")) I YSCLDFN="" S YSCLER=" "_$P(XMRG,",")_" is not a valid SSN at " D OUT Q 83 . I '$D(^YSCL(603.01,"C",YSCLDFN)) S YSCLER=" "_$P(XMRG,",",2)_" is not registered at " D OUT Q 84 . S YSCLA=$O(^YSCL(603.01,"B",$P(XMRG,","),"")) I YSCLA="" S YSCLER=" "_$P(XMRG,",")_" is not a valid entry at " D OUT Q 85 . K ^YSCL(603.01,YSCLA),^YSCL(603.01,"B",$P(XMRG,","),YSCLA),^YSCL(603.01,"C",YSCLDFN,YSCLA) 86 . S YSCLER=" removed at " D OUT 87 . ;I $D(^YSCL(603.01,"C",+Y)) K ^YSCL(603.01,YSCLA),^YSCL(603.01,"B",$P(XMRG,","),YSCLA),^YSCL(603.01,"C",YSCLDFN,YSCLA) S YSCLER=" removed at " D OUT Q ;RLM 9-29-99 ADDED QUIT 88 G EXIT 89 DELALL ;Delete all patients in file 603.01 90 S YSCLA=0 F S YSCLA=$O(^YSCL(603.01,YSCLA)) Q:YSCLA="" D 91 . I YSCLA S YSCLER=$P(^YSCL(603.01,YSCLA,0),"^",1)_", "_$P(^DPT($P(^YSCL(603.01,YSCLA,0),"^",2),0),"^",9)_", ("_$P(^YSCL(603.01,YSCLA,0),"^",3)_") gdeleted at " D OUT 92 . K ^YSCL(603.01,YSCLA) 93 Q 94 REPORT ;send report of current registrations to the Clozapine group on Forum 95 D REPORT^YSCLSRV2 G EXIT 96 OUT S YSCLLNT=$G(YSCLLNT)+1,^TMP($J,"YSCLDATA",YSCLLNT)=XMRG_YSCLER_YSCLST Q 97 ;Build the text for the return message here. 98 REBUILD ; 99 D REBUILD^YSCLSRV2 G EXIT 100 UPDATE ;Update record with Monthly, Weekly or Bi-weekly status 101 F X XMREC Q:XMER<0 S XMRG=$TR(XMRG,"- ","") D 102 . I XMRG'?2U5N1","9N1","1U S YSCLER=" is in error and was not added at " D OUT Q 103 . I $P(XMRG,",")'?2U5N S YSCLER=" is not a valid Clozapine number format " D OUT Q 104 . I $P(XMRG,",",2)'?9N S YSCLER=" An SSN must be 9 numbers " D OUT Q 105 . I $P(XMRG,",",3)'="B",$P(XMRG,",",3)'="W",$P(XMRG,",",3)'="M" S YSCLER=" You must specify Monthly, Weekly or Biweekly " D OUT Q ;RLM 06/15/05 106 . S YSCLNM=$P(XMRG,","),YSCLSSN=$P(XMRG,",",2),YSCLWB=$P(XMRG,",",3) 107 . I '$D(^YSCL(603.01,"B",YSCLNM)) S YSCLER=" does not exist at " D OUT Q 108 . S YSCLDA=$O(^DPT("SSN",YSCLSSN,0)) 109 . I YSCLDA="" S YSCLER=" SSN does not exist at " D OUT Q 110 . I $O(^YSCL(603.01,"B",YSCLNM,0))="" S YSCLER=" SSN not in Clozapine file " D OUT Q 111 . I $O(^DPT("SSN",YSCLSSN,YSCLDA)) S YSCLER=" SSN has more than one owner " D OUT Q 112 . I $O(^YSCL(603.01,"B",YSCLNM,0))'=$O(^YSCL(603.01,"C",YSCLDA,0)) S YSCLER=" SSN ("_YSCLSSN_","_$P(^DPT(YSCLDA,0),"^")_") has multiple Clozapine Numbers at " D OUT 113 . I $O(^YSCL(603.01,"B",YSCLNM,0))=$O(^YSCL(603.01,"C",YSCLDA,0)) D 114 . . S YSCLDA1=$O(^YSCL(603.01,"B",YSCLNM,0)) S $P(^YSCL(603.01,YSCLDA1,0),"^",3)=YSCLWB 115 . . S YSCLER=" "_YSCLNM_" ("_$P(^DPT(YSCLDA,0),"^")_") updated to "_$S(YSCLWB="M":"Monthly",YSCLWB="W":"Weekly",YSCLWB="B":"Bi-weekly",1:"Unknown")_" at " D OUT ;06/15/05 116 G EXIT 117 RESEND ;Trigger retransmission of Clozapine data 118 X XMREC 119 K %DT S X=XMRG,%DT="P" D ^%DT I Y=-1 S YSCLER=" is an invalid date, RESEND not triggered at " D OUT G EXIT 120 S YSCLED=Y,(YSCLSDT,X)=Y D H^%DTC I %H#7'=5 S YSCLER=" is not a Tuesday, RESEND not triggered at " D OUT G EXIT 121 D SERV^YSCLTST2 122 S Y=YSCLSDT X ^DD("DD") S YSCLER=" - Resend triggered (local task #"_$G(ZTSK)_") by "_XMFROM_" for "_Y_" at " D OUT 123 G EXIT 124 DSET ;Set the day of the week for the roll-up to run. 125 X XMREC Q:XMER<0 S X=$TR(XMRG,"- ","") 126 S YSOFF=$S(X="SUNDAY":0,X="MONDAY":1,X="TUESDAY":2,X="WEDNESDAY":3,X="THURSDAY":4,X="FRIDAY":5,X="SATURDAY":6,1:7) 127 I YSOFF>6 S YSCLLNT=$G(YSCLLNT)+1,^TMP($J,"YSCLDATA",YSCLLNT)=X_" isn't a valid day of the week." G EXIT 128 S $P(^YSCL(603.03,1,0),"^",2)=X 129 S YSCLLNT=$G(YSCLLNT)+1,^TMP($J,"YSCLDATA",YSCLLNT)="Run day set to "_X 130 G EXIT 131 Q 132 DEBUG ;Turn debug mode on and off. 133 I YSCLSUB["DEBUG ON" D 134 . S YSCLLNT=$G(YSCLLNT)+1,^TMP($J,"YSCLDATA",YSCLLNT)="Debug Mode is "_$S(YSDEBUG:"already",1:"now")_" ON at "_YSCLSTN 135 . S $P(^YSCL(603.03,1,0),"^",3)=1 136 I YSCLSUB["DEBUG OFF" D 137 . S YSCLLNT=$G(YSCLLNT)+1,^TMP($J,"YSCLDATA",YSCLLNT)="Debug Mode is "_$S('YSDEBUG:"already",1:"now")_" OFF at "_YSCLSTN 138 . S $P(^YSCL(603.03,1,0),"^",3)=0 139 G EXIT 140 ZEOR ;YSCLSERV 1 YSCLSERV ;DALOI/RLM-Clozapine data server ;24 APR 1990 2 ;;5.01;MENTAL HEALTH;**18,22,26,47,61,69,74,90**;Dec 30, 1994;Build 18 3 ; Reference to ^%ZOSF supported by IA #10096 4 ; Reference to ^DPT supported by IA #10035 5 ; Reference to ^DD("DD" supported by IA #10017 6 ; Reference to ^PS(55 supported by IA #787 7 ; Reference to ^PSDRUG supported by IA #25 8 ; Reference to ^PSRX supported by IA #780 9 ; Reference to ^VA(200 supported by IA #10060 10 ; Reference to $$SITE^VASITE supported by IA #10112 11 ; Reference to $$FMTE^XLFDT() supported by IA #10103 12 ; Reference to ^PSDRUG supported by IA #221 13 ; Reference to ^XMD supported by IA #10070 14 START ; 15 K ^TMP($J,"YSCLDATA") 16 S YSDEBUG=$P(^YSCL(603.03,1,0),"^",3) 17 S YSCLST=$P($$SITE^VASITE,"^",3) 18 S YSCLSTN=$P($$SITE^VASITE,"^",2) 19 ;Determine station number 20 S X=XQSUB X ^%ZOSF("UPPERCASE") S YSCLSUB=Y 21 S ^TMP($J,"YSCLDATA",1)=$S(YSDEBUG:"DEBUG ",1:"")_YSCLSUB_" triggered at "_YSCLST_" by "_XMFROM_" on "_XQDATE 22 ;The first line of the message tells who requested the action and when 23 D 24 . S YSACTION=$S(YSCLSUB["REMOVE"!(YSCLSUB["DELETE"):"data deleted",YSCLSUB["REPORT":"report generated",YSCLSUB["REBUILD":"data verified",YSCLSUB["UPDATE":"data updated",YSCLSUB["DATESET":"date set",1:"CONT") 25 . I YSACTION="CONT" S YSACTION=$S(YSCLSUB["DEMOG RESET":"Demographics Flag Reset",YSCLSUB["DEBUG":"Debug Mode set",YSCLSUB["AUTH":"Authorization",YSCLSUB["LOCK":"Lock",1:"Site Lock") 26 . S ^TMP($J,"YSCLDATA",2)="No "_$S(YSDEBUG:"DEBUG ",1:"")_YSACTION_" at "_YSCLST 27 ;The second line tells when the server is activated and no data can be 28 ;gathered from the MailMan message. This line gets replaced if the 29 ;server finds something to do. 30 S YSCLLNT=1 I YSCLSUB["REMOVE"!(YSCLSUB["DELETE") G DELETE 31 ;If the subject contains the word REMOVE or DELETE delete those entries from the list. 32 I YSCLSUB["REPORT" G REPORT 33 ;If the subject contains "REPORT" send a report of the currently registered patients to the Clozapine group on Forum 34 ;I YSCLSUB["REBUILD" G REBUILD 35 I YSCLSUB["RESEND" G RESEND 36 I YSCLSUB["UPDATE" G UPDATE 37 I YSCLSUB["CHECKSUM" G CSUM^YSCLSRV1 38 I YSCLSUB["DATESET" G DSET 39 I YSCLSUB["DEBUG" G DEBUG 40 I YSCLSUB["PATIENT" G ^YSCLSRV3 41 I YSCLSUB["LOCKOUT" G LOCK^YSCLSRV3 42 I YSCLSUB="DEMOG RESET" G DEMOG^YSCLSRV3 43 I YSCLSUB["AUTHORIZE" G AUTH^YSCLSRV3 44 I YSCLSUB="OVERRIDE" G OVRRID^YSCLSRV2 45 F X XMREC Q:XMER<0 S XMRG=$TR(XMRG,"- ","") D 46 . ;Verify that + of site number matches local site number 47 . I XMRG'?2U5N1","9N1","1U S YSCLER=" is in error and was not added at " D OUT Q 48 . I $P(XMRG,",")'?2U5N S YSCLER=" is not a valid Clozapine number " D OUT Q 49 . I $P(XMRG,",",2)'?9N S YSCLER=" An SSN must be 9 numbers " D OUT Q 50 . I $P(XMRG,",",3)'="B",$P(XMRG,",",3)'="W",$P(XMRG,",",3)'="M" S YSCLER=" You must specify Weekly, Biweekly, or Monthly " D OUT Q 51 . ;Validate the format of the data in the message and report the error. 52 . S DIC="^DPT(",DIC(0)="X",D="SSN",X=$P(XMRG,",",2) I '$D(^DPT("SSN",X)) S YSCLER=" SSN does not exist at " D OUT Q 53 . ;Do not add data for records where the SSN sent is not in the local database 54 . I $D(^YSCL(603.01,"B",$P(XMRG,","))) S YSCLX=$O(^YSCL(603.01,"B",$P(XMRG,","),"")) S:YSCLX]"" YSCLX=$P(^YSCL(603.01,YSCLX,0),"^",2),YSCLER=" Clozapine # is in use by "_$P($G(^DPT(YSCLX,0)),"^")_" at " D OUT Q 55 . D MIX^DIC1 S YSCLPT=+Y I Y=-1 S YSCLER=" could not be added at " D OUT Q 56 . ;Add the data and report any errors to the Roll-Up group at Forum. 57 . K DD S DIC="^YSCL(603.01,",X=$P(XMRG,","),DIC("DR")="1////"_YSCLPT_";2////"_$P(XMRG,",",3) K DO D FILE^DICN 58 . S YSCLX=$O(^YSCL(603.01,"B",$P(XMRG,","),"")) S:YSCLX]"" YSCLX=$P(^YSCL(603.01,YSCLX,0),"^",2),YSCLER=" assigned to "_$P($G(^DPT(YSCLX,0)),"^")_" at " D OUT 59 EXIT ;If all went well, report that too. 60 S YSDEBUG=$P(^YSCL(603.03,1,0),"^",3) 61 S %H=$H D YMD^%DTC S XMDUN="NCCC LOGGER",XMDUZ=".5",XMSUB=$S(YSDEBUG:"DEBUG ",YSCLSUB["DEBUG":"DEBUG ",1:"")_YSCLST_" NCCC ENROLLER ("_X_%_")",XMTEXT="^TMP($J,""YSCLDATA""," 62 K XMY S XMY("G.CLOZAPINE ROLL-UP@FORUM.VA.GOV")="" 63 I YSDEBUG!(YSCLSUB["DEBUG") S XMY("G.CLOZAPINE DEBUG@FO-DALLAS.MED.VA.GOV")="" 64 D ^XMD 65 ;Mail the errors and successes back to the Roll-Up group at Forum. 66 K ^TMP($J,"YSCLDATA") 67 K %,%DT,%H,D,DA,DD,DIC,DIE,DIK,RET,X,XMDUN,XMDUZ,XMER,XMFROM 68 K XMREC,XMRG,XMSUB,XMTEXT,XMY,XMZ,XQDATE,XQSUB,Y,YSA,YSACTION 69 K YSCL28,YSCLA,YSCLAA,YSCLB,YSCLC,YSCLDA,YSCLDA1,YSCLDATA,YSCLDEA1 70 K YSCLDFN,YSCLDM,YSCLDOC,YSCLDOM,YSCLDR,YSCLDRA,YSCLDRB,YSCLDTA 71 K YSCLDUZ,YSCLED,YSCLER,YSCLFDA,YSCLFRQ,YSCLLNT,YSCLNM,YSCLOVR 72 K YSCLPT,YSCLSD1,YSCLSDT,YSCLSSN,YSCLST,YSCLSTN,YSCLSUB,YSCLTC 73 K YSCLWB,YSCLX,YSCLYN,YSDEBUG,YSI,YSOFF,YSPR,ZTQUEUED,ZTSK 74 Q 75 DELETE ;Allow the NCCC users to delete clozapine registration at the individual sites 76 S YSCLLNT=1 F X XMREC Q:XMER<0 S XMRG=$TR(XMRG,"- ","") D 77 . I XMRG="**++**DELETEALL**++**" D DELALL Q 78 . I '$D(^YSCL(603.01,"B",$P(XMRG,","))) S YSCLER=" "_$P(XMRG,",")_" is not registered at " D OUT Q 79 . S YSCLDFN=$O(^DPT("SSN",$P(XMRG,",",2),"")) I YSCLDFN="" S YSCLER=" "_$P(XMRG,",")_" is not a valid SSN at " D OUT Q 80 . I '$D(^YSCL(603.01,"C",YSCLDFN)) S YSCLER=" "_$P(XMRG,",",2)_" is not registered at " D OUT Q 81 . S YSCLA=$O(^YSCL(603.01,"B",$P(XMRG,","),"")) I YSCLA="" S YSCLER=" "_$P(XMRG,",")_" is not a valid entry at " D OUT Q 82 . K ^YSCL(603.01,YSCLA),^YSCL(603.01,"B",$P(XMRG,","),YSCLA),^YSCL(603.01,"C",YSCLDFN,YSCLA) 83 . S YSCLER=" removed at " D OUT 84 . ;I $D(^YSCL(603.01,"C",+Y)) K ^YSCL(603.01,YSCLA),^YSCL(603.01,"B",$P(XMRG,","),YSCLA),^YSCL(603.01,"C",YSCLDFN,YSCLA) S YSCLER=" removed at " D OUT Q ;RLM 9-29-99 ADDED QUIT 85 G EXIT 86 DELALL ;Delete all patients in file 603.01 87 S YSCLA=0 F S YSCLA=$O(^YSCL(603.01,YSCLA)) Q:YSCLA="" D 88 . I YSCLA S YSCLER=$P(^YSCL(603.01,YSCLA,0),"^",1)_", "_$P(^DPT($P(^YSCL(603.01,YSCLA,0),"^",2),0),"^",9)_", ("_$P(^YSCL(603.01,YSCLA,0),"^",3)_") gdeleted at " D OUT 89 . K ^YSCL(603.01,YSCLA) 90 Q 91 REPORT ;send report of current registrations to the Clozapine group on Forum 92 D REPORT^YSCLSRV2 G EXIT 93 OUT S YSCLLNT=$G(YSCLLNT)+1,^TMP($J,"YSCLDATA",YSCLLNT)=XMRG_YSCLER_YSCLST Q 94 ;Build the text for the return message here. 95 REBUILD ; 96 D REBUILD^YSCLSRV2 G EXIT 97 UPDATE ;Update record with Monthly, Weekly or Bi-weekly status 98 F X XMREC Q:XMER<0 S XMRG=$TR(XMRG,"- ","") D 99 . I XMRG'?2U5N1","9N1","1U S YSCLER=" is in error and was not added at " D OUT Q 100 . I $P(XMRG,",")'?2U5N S YSCLER=" is not a valid Clozapine number format " D OUT Q 101 . I $P(XMRG,",",2)'?9N S YSCLER=" An SSN must be 9 numbers " D OUT Q 102 . I $P(XMRG,",",3)'="B",$P(XMRG,",",3)'="W",$P(XMRG,",",3)'="M" S YSCLER=" You must specify Monthly, Weekly or Biweekly " D OUT Q ;RLM 06/15/05 103 . S YSCLNM=$P(XMRG,","),YSCLSSN=$P(XMRG,",",2),YSCLWB=$P(XMRG,",",3) 104 . I '$D(^YSCL(603.01,"B",YSCLNM)) S YSCLER=" does not exist at " D OUT Q 105 . S YSCLDA=$O(^DPT("SSN",YSCLSSN,0)) 106 . I YSCLDA="" S YSCLER=" SSN does not exist at " D OUT Q 107 . I $O(^YSCL(603.01,"B",YSCLNM,0))="" S YSCLER=" SSN not in Clozapine file " D OUT Q 108 . I $O(^DPT("SSN",YSCLSSN,YSCLDA)) S YSCLER=" SSN has more than one owner " D OUT Q 109 . I $O(^YSCL(603.01,"B",YSCLNM,0))'=$O(^YSCL(603.01,"C",YSCLDA,0)) S YSCLER=" SSN ("_YSCLSSN_","_$P(^DPT(YSCLDA,0),"^")_") has multiple Clozapine Numbers at " D OUT 110 . I $O(^YSCL(603.01,"B",YSCLNM,0))=$O(^YSCL(603.01,"C",YSCLDA,0)) D 111 . . S YSCLDA1=$O(^YSCL(603.01,"B",YSCLNM,0)) S $P(^YSCL(603.01,YSCLDA1,0),"^",3)=YSCLWB 112 . . S YSCLER=" "_YSCLNM_" ("_$P(^DPT(YSCLDA,0),"^")_") updated to "_$S(YSCLWB="M":"Monthly",YSCLWB="W":"Weekly",YSCLWB="B":"Bi-weekly",1:"Unknown")_" at " D OUT ;06/15/05 113 G EXIT 114 RESEND ;Trigger retransmission of Clozapine data 115 X XMREC 116 K %DT S X=XMRG,%DT="P" D ^%DT I Y=-1 S YSCLER=" is an invalid date, RESEND not triggered at " D OUT G EXIT 117 S YSCLED=Y,(YSCLSDT,X)=Y D H^%DTC I %H#7'=5 S YSCLER=" is not a Tuesday, RESEND not triggered at " D OUT G EXIT 118 D SERV^YSCLTST2 119 S Y=YSCLSDT X ^DD("DD") S YSCLER=" - Resend triggered (local task #"_$G(ZTSK)_") by "_XMFROM_" for "_Y_" at " D OUT 120 G EXIT 121 DSET ;Set the day of the week for the roll-up to run. 122 X XMREC Q:XMER<0 S X=$TR(XMRG,"- ","") 123 S YSOFF=$S(X="SUNDAY":0,X="MONDAY":1,X="TUESDAY":2,X="WEDNESDAY":3,X="THURSDAY":4,X="FRIDAY":5,X="SATURDAY":6,1:7) 124 I YSOFF>6 S YSCLLNT=$G(YSCLLNT)+1,^TMP($J,"YSCLDATA",YSCLLNT)=X_" isn't a valid day of the week." G EXIT 125 S $P(^YSCL(603.03,1,0),"^",2)=X 126 S YSCLLNT=$G(YSCLLNT)+1,^TMP($J,"YSCLDATA",YSCLLNT)="Run day set to "_X 127 G EXIT 128 Q 129 DEBUG ;Turn debug mode on and off. 130 I YSCLSUB["DEBUG ON" D 131 . S YSCLLNT=$G(YSCLLNT)+1,^TMP($J,"YSCLDATA",YSCLLNT)="Debug Mode is "_$S(YSDEBUG:"already",1:"now")_" ON at "_YSCLSTN 132 . S $P(^YSCL(603.03,1,0),"^",3)=1 133 I YSCLSUB["DEBUG OFF" D 134 . S YSCLLNT=$G(YSCLLNT)+1,^TMP($J,"YSCLDATA",YSCLLNT)="Debug Mode is "_$S('YSDEBUG:"already",1:"now")_" OFF at "_YSCLSTN 135 . S $P(^YSCL(603.03,1,0),"^",3)=0 136 G EXIT 137 ZEOR ;YSCLSERV -
WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSCLSRV2.m
r613 r623 1 YSCLSRV2 ;DALOI/RLM-Clozapine data server ;APR 24,1990@15:26 2 ;;5.01;MENTAL HEALTH;**69,90,92**;Dec 30, 1994;Build 7 3 ; Reference to ^%ZOSF supported by IA #10096 4 ; Reference to ^DPT supported by IA #10035 5 ; Reference to ^DD("DD" supported by IA #10017 6 ; Reference to ^PS(55 supported by IA #787 7 ; Reference to ^PSDRUG supported by IA #25 8 ; Reference to ^PSRX supported by IA #780 9 ; Reference to ^VA(200 supported by IA #10060 10 ; Reference to $$SITE^VASITE supported by IA #10112 11 ; Reference to $$FMTE^XLFDT() supported by IA #10103 12 ; Reference to ^PSDRUG supported by IA #221 13 ; Reference to ^LAB(60 supported by IA #333 14 ; 15 REPORT ;send report of current registrations to the Clozapine group on Forum 16 S XMRG="",YSCLA=0 F S YSCLA=$O(^YSCL(603.01,YSCLA)) Q:'YSCLA S YSCLDTA=$G(^YSCL(603.01,YSCLA,0)) D 17 . I YSCLDTA="" S YSCLER="Clozapine Patient List damaged at " D OUT Q 18 . S YSCLWB=$P(YSCLDTA,"^",3),YSCLWB=$S(YSCLWB="M":"Monthly",YSCLWB="W":"Weekly",YSCLWB="B":"Bi-weekly",1:"Unknown") 19 . S YSCLER=$P(YSCLDTA,"^")_" is assigned to "_$P($G(^DPT($P(YSCLDTA,"^",2),0)),"^")_" ("_$P($G(^DPT($P(YSCLDTA,"^",2),0)),"^",9)_") "_YSCLWB_" at " D OUT 20 S YSCLLNT=$G(YSCLLNT)+1,^TMP($J,"YSCLDATA",YSCLLNT)="==========" 21 S YSCLLNT=$G(YSCLLNT)+1,^TMP($J,"YSCLDATA",YSCLLNT)=" Linked Tests:" 22 S YSCLA=0 F S YSCLA=$O(^YSCL(603.04,1,1,YSCLA)) Q:'YSCLA D 23 . S YSCLLNT=$G(YSCLLNT)+1,^TMP($J,"YSCLDATA",YSCLLNT)=$P(^LAB(60,$P(^YSCL(603.04,1,1,YSCLA,0),"^",1),0),"^") 24 . S YSCLTYPE=$P(^YSCL(603.04,1,1,YSCLA,0),"^",2),YSCLRPT=$P(^YSCL(603.04,1,1,YSCLA,0),"^",3) 25 . S YSCLTA=" reports "_$S(YSCLTYPE="W":"WHITE BLOOD COUNT",YSCLTYPE="A":"ABSOLUTE NEUTROPHIL COUNT",YSCLTYPE="N":"NEUTROPHIL PERCENT",YSCLTYPE="S":"SEGS %",YSCLTYPE="B":"BANDS %",YSCLTYPE="T":"BANDS A",YSCLTYPE="C":"SEGS A") 26 . S ^TMP($J,"YSCLDATA",YSCLLNT)=^TMP($J,"YSCLDATA",YSCLLNT)_YSCLTA_" "_$S(YSCLRPT:"K/units",1:"units") 27 S YSCLLNT=$G(YSCLLNT)+1,^TMP($J,"YSCLDATA",YSCLLNT)="==========" 28 ;D OPTION^%ZTLOAD("YSCL WEEKLY TRANSMISSION","LIST") D 29 ; . S ZTSK="" F S ZTSK=$O(LIST(ZTSK)) Q:ZTSK="" D 30 ; . . D STAT^%ZTLOAD S YSCLLNT=$G(YSCLLNT)+1,^TMP($J,"YSCLDATA",YSCLLNT)="Local Task # "_ZTSK_" is "_$S('ZTSK(0):" not ",1:"")_"defined with a status of "_ZTSK(2) 31 S YSCLLNT=$G(YSCLLNT)+1,^TMP($J,"YSCLDATA",YSCLLNT)=" Run day is: "_$P(^YSCL(603.03,1,0),"^",2) 32 S YSCLLNT=$G(YSCLLNT)+1,^TMP($J,"YSCLDATA",YSCLLNT)=" Debug Mode is: "_$S($P(^YSCL(603.03,1,0),"^",3):"On.",1:"Off.") 33 S YSCLLNT=$G(YSCLLNT)+1,^TMP($J,"YSCLDATA",YSCLLNT)="Last Run Date (start) is: "_$$FMTE^XLFDT($P(^YSCL(603.03,1,0),"^",4)) 34 S YSCLLNT=$G(YSCLLNT)+1,^TMP($J,"YSCLDATA",YSCLLNT)=" Last Run Date (stop) is: "_$$FMTE^XLFDT($P(^YSCL(603.03,1,0),"^",5)) 35 S YSCLLNT=$G(YSCLLNT)+1,^TMP($J,"YSCLDATA",YSCLLNT)="Last Demographic date is: "_$$FMTE^XLFDT($P(^YSCL(603.03,1,0),"^",6)) 36 Q 37 OUT S YSCLLNT=$G(YSCLLNT)+1,^TMP($J,"YSCLDATA",YSCLLNT)=XMRG_YSCLER_YSCLST Q 38 ;Build the text for the return message here. 39 REBUILD ; 40 S XMRG="",(YSCLA,YSCLLNT)=1 F S YSCLA=$O(^PS(55,"ASAND1",YSCLA)) W:'$D(ZTQUEUED) "." Q:YSCLA="" D 41 . S YSCLB=$O(^PS(55,"ASAND1",YSCLA,"")) I YSCLB="" S YSCLER=" record is in error (1) at " D OUT Q 42 . I '$D(^PS(55,YSCLB,0)) S YSCLER=" record is in error (2) at " D OUT Q 43 . S YSCLB=$P(^PS(55,YSCLB,0),"^") I YSCLB="" S YSCLER=" record is in error (3) at " D OUT Q 44 . I '$D(^PS(55,YSCLB,"SAND")) S YSCLER=" record is in error (4) at " D OUT Q 45 . S DIC="^DPT(",DIC(0)="X",D="SSN",(YSCLSSN,X)=$P(^DPT(YSCLB,0),"^",9) 46 . I $D(^YSCL(603.01,"B",YSCLA)) S YSCLX=$O(^YSCL(603.01,"B",YSCLA,"")) S:YSCLX]"" YSCLX=$P(^YSCL(603.01,YSCLX,0),"^",2),YSCLER=" Clozapine # "_YSCLA_" is in use by "_$P($G(^DPT(YSCLX,0)),"^")_" at " D OUT Q 47 . D MIX^DIC1 S YSCLPT=+Y I Y=-1 S YSCLER=" could not be added at " D OUT Q 48 . K DD S DIC="^YSCL(603.01,",X=YSCLA,DIC("DR")="1////"_YSCLPT K DO D FILE^DICN 49 . S YSCLX=$O(^YSCL(603.01,"B",YSCLA,"")) S:YSCLX]"" YSCLX=$P(^YSCL(603.01,YSCLX,0),"^",2),YSCLER=","_YSCLSSN_" assigned to "_$P($G(^DPT(YSCLX,0)),"^")_" at " D OUT 50 Q 51 OVRRID ;Update record with Monthly, Weekly or Bi-weekly status 52 F X XMREC Q:XMER<0 S XMRG=$TR(XMRG,"- ","") D 53 . I XMRG'?2U5N1","9N1",".E S YSCLER=" is in error and was not added at " D OUT Q 54 . I $P(XMRG,",")'?2U5N S YSCLER=" is not a valid Clozapine number format " D OUT Q 55 . I $P(XMRG,",",2)'?9N S YSCLER=" An SSN must be 9 numbers " D OUT Q 56 . K %DT S X=$P(XMRG,",",3),%DT="F" D ^%DT I Y=-1 S YSCLER=" is an invalid date, over-ride authorization not filed at " D OUT Q 57 . S YSCLOVR=Y 58 . S YSCLNM=$P(XMRG,","),YSCLSSN=$P(XMRG,",",2),YSCLWB=$P(XMRG,",",3) 59 . I '$D(^YSCL(603.01,"B",YSCLNM)) S YSCLER=" does not exist at " D OUT Q 60 . S YSCLDA=$O(^DPT("SSN",YSCLSSN,0)) 61 . I YSCLDA="" S YSCLER=" SSN does not exist at " D OUT Q 62 . I $O(^YSCL(603.01,"B",YSCLNM,0))="" S YSCLER=" SSN not in Clozapine file " D OUT Q 63 . I $O(^DPT("SSN",YSCLSSN,YSCLDA)) S YSCLER=" SSN has more than one owner " D OUT Q 64 . I $O(^YSCL(603.01,"B",YSCLNM,0))'=$O(^YSCL(603.01,"C",YSCLDA,0)) S YSCLER=" SSN ("_YSCLSSN_","_$P(^DPT(YSCLDA,0),"^")_") has multiple Clozapine Numbers at " D OUT 65 . I $O(^YSCL(603.01,"B",YSCLNM,0))=$O(^YSCL(603.01,"C",YSCLDA,0)) D 66 . . S YSCLDA1=$O(^YSCL(603.01,"B",YSCLNM,0)) S $P(^YSCL(603.01,YSCLDA1,0),"^",4)=YSCLOVR 67 . . S Y=YSCLOVR D DD^%DT S YSCLER=" "_YSCLNM_" ("_$P(^DPT(YSCLDA,0),"^")_") authorized for over-ride on "_Y_" at " D OUT 68 G EXIT^YSCLSERV 69 ; 70 CLAPI ; 71 F X XMREC Q:XMER<0 S XMRG=$TR(XMRG,"- ","") D 72 . ;Verify that a valid Clozapine number is listed 73 . S YSCLDA=$E(XMRG,1,7) 74 . I YSCLDA'?2U5N S YSCLER=" is not a valid Clozapine number " D OUT Q 75 . S YSCLDA=$O(^YSCL(603.01,"B",YSCLDA,"")),YSCLDA=$P($G(^YSCL(603.01,YSCLDA,0)),"^",2) 76 . I 'YSCLDA S YSCLER=" is not in the local database." D OUT Q 77 . S YSCLNM=$$CL^YSCLTST2(YSCLDA) S YSCLER=" = "_YSCLNM_" at " D OUT 78 . Q 79 G EXIT^YSCLSERV 80 CL1API ; 81 F X XMREC Q:XMER<0 S XMRG=$TR(XMRG,"- ","") D 82 . ;Verify that a valid Clozapine number is listed 83 . S YSA=$P(XMRG,"^",1),YSCLDA=$P(XMRG,"^",2) 84 . I YSCLDA'?2U5N S YSCLER=" is not a valid Clozapine number " D OUT Q 85 . S YSCLDA=$O(^YSCL(603.01,"B",YSCLDA,"")),YSCLDA=$P($G(^YSCL(603.01,YSCLDA,0)),"^",2) 86 . I 'YSCLDA S YSCLER=" is not in the local database." D OUT Q 87 . D CL1^YSCLTST2(YSCLDA,YSA) D 88 . . S YSCLDA1="" F S YSCLDA1=$O(^TMP($J,"PSO",YSCLDA1)) Q:'YSCLDA1 S YSCLER=" = "_YSCLDA_"="_(9999999-YSCLDA1)_" = "_^TMP($J,"PSO",YSCLDA1)_" at " D OUT 89 . Q 90 G EXIT^YSCLSERV 91 Q 92 DCON ; 93 F X XMREC Q:XMER<0 S XMRG=$TR(XMRG,"- ","") D 94 . ;Verify that a valid Clozapine number is listed 95 . S (YSA,YSCLDA)=$E(XMRG,1,7) 96 . I YSCLDA'?2U5N S YSCLER=" is not a valid Clozapine number " D OUT Q 97 . S YSCLDA=$O(^YSCL(603.01,"B",YSCLDA,"")),YSCLDA=$P($G(^YSCL(603.01,YSCLDA,0)),"^",2) 98 . I 'YSCLDA S YSCLER=" is not in the local database." D OUT Q 99 . I $P(^PS(55,YSCLDA,"SAND"),"^",2)'="D" S YSCLER=YSA_" is not discontinued" D OUT Q 100 . S YSCLER=YSA_" was "_$P(^PS(55,YSCLDA,"SAND"),"^",2)_" is now ""A""" D OUT 101 . S $P(^PS(55,YSCLDA,"SAND"),"^",2)="A" 102 ZEOR ;YSCLSRV2 1 YSCLSRV2 ;DALOI/RLM-Clozapine data server ;APR 24,1990@15:26 2 ;;5.01;MENTAL HEALTH;**69,90**;Dec 30, 1994;Build 18 3 ; Reference to ^%ZOSF supported by IA #10096 4 ; Reference to ^DPT supported by IA #10035 5 ; Reference to ^DD("DD" supported by IA #10017 6 ; Reference to ^PS(55 supported by IA #787 7 ; Reference to ^PSDRUG supported by IA #25 8 ; Reference to ^PSRX supported by IA #780 9 ; Reference to ^VA(200 supported by IA #10060 10 ; Reference to $$SITE^VASITE supported by IA #10112 11 ; Reference to $$FMTE^XLFDT() supported by IA #10103 12 ; Reference to ^PSDRUG supported by IA #221 13 ; Reference to ^LAB(60 supported by IA #333 14 ; 15 REPORT ;send report of current registrations to the Clozapine group on Forum 16 S XMRG="",YSCLA=0 F S YSCLA=$O(^YSCL(603.01,YSCLA)) Q:'YSCLA S YSCLDTA=$G(^YSCL(603.01,YSCLA,0)) D 17 . I YSCLDTA="" S YSCLER="Clozapine Patient List damaged at " D OUT Q 18 . S YSCLWB=$P(YSCLDTA,"^",3),YSCLWB=$S(YSCLWB="M":"Monthly",YSCLWB="W":"Weekly",YSCLWB="B":"Bi-weekly",1:"Unknown") 19 . S YSCLER=$P(YSCLDTA,"^")_" is assigned to "_$P($G(^DPT($P(YSCLDTA,"^",2),0)),"^")_" ("_$P($G(^DPT($P(YSCLDTA,"^",2),0)),"^",9)_") "_YSCLWB_" at " D OUT 20 I YSCLSUB["+" S YSCLLNT=$G(YSCLLNT)+1,^TMP($J,"YSCLDATA",YSCLLNT)="====" S YSCLA=0 F S YSCLA=$O(^PS(55,"ASAND",YSCLA)) Q:'YSCLA S YSCLER="" D D:YSCLER]"" OUT ;Transmit the most recent for each patient. 21 . S YSCLDFN=$P(^PS(55,YSCLA,0),"^") ;Find out who we're reporting on 22 . S YSCLNM=$P(^DPT(YSCLDFN,0),"^") ;Get the patients name 23 . S YSCLSD1=YSCLNM_"^"_^PS(55,YSCLA,"SAND") ;Add name to data 24 . S YSCLZZ=YSCLA,$P(YSCLSD1,"^",4)=$P($$CL^YSCLTST2(YSCLDFN),"^",2),YSCLA=YSCLZZ 25 . S YSCLDOC=$P(YSCLSD1,"^",6) I YSCLDOC K DIERR,YSCL200 D FIND^DIC(200,,".01","X","`"_YSCLDOC,,,,,"YSCL200","YERROR") S $P(YSCLSD1,"^",6)=$G(YSCL200("DILIST",1,1)) 26 . ;S YSCLDOC=$P(YSCLSD1,"^",6) I YSCLDOC S $P(YSCLSD1,"^",6)=$P($G(^VA(200,YSCLDOC,0)),"^") ;OLD CODE 27 . S $P(YSCLSD1,"^",7)=$P(YSCLSD1,"^",7) ;Pad it to 7 ^-pieces 28 . S YSCLB=0 F S YSCLB=$O(^PS(55,YSCLA,"P",YSCLB)) Q:'YSCLB I $D(^PSRX(^PS(55,YSCLA,"P",YSCLB,0),"SAND")) D ;D OUT ;This will transmit them all 29 . . S YSCLER=YSCLSD1_"^"_$G(^PSRX(^PS(55,YSCLA,"P",YSCLB,0),"SAND"))_"^" 30 . . S Y=$P(YSCLER,"^",7) I Y]"" X ^DD("DD") S $P(YSCLER,"^",7)=Y 31 . . S Y=$P(YSCLER,"^",10) I Y]"" X ^DD("DD") S $P(YSCLER,"^",10)=Y 32 . ;D OUT 33 S YSCLLNT=$G(YSCLLNT)+1,^TMP($J,"YSCLDATA",YSCLLNT)=" Linked Tests:" 34 S YSCLA=0 F S YSCLA=$O(^YSCL(603.04,1,1,YSCLA)) Q:'YSCLA D 35 . S YSCLLNT=$G(YSCLLNT)+1,^TMP($J,"YSCLDATA",YSCLLNT)=$P(^LAB(60,$P(^YSCL(603.04,1,1,YSCLA,0),"^",1),0),"^") 36 . S YSCLTYPE=$P(^YSCL(603.04,1,1,YSCLA,0),"^",2),YSCLRPT=$P(^YSCL(603.04,1,1,YSCLA,0),"^",3) 37 . S YSCLTA=" reports "_$S(YSCLTYPE="W":"WHITE BLOOD COUNT",YSCLTYPE="A":"ABSOLUTE NEUTROPHIL COUNT",YSCLTYPE="N":"NEUTROPHIL PERCENT",YSCLTYPE="S":"SEGS %",YSCLTYPE="B":"BANDS %",YSCLTYPE="T":"BANDS A",YSCLTYPE="C":"SEGS A") 38 . S ^TMP($J,"YSCLDATA",YSCLLNT)=^TMP($J,"YSCLDATA",YSCLLNT)_YSCLTA_" "_$S(YSCLRPT:"K/units",1:"units") 39 ;Old method 40 ;S YSCLLNT=$G(YSCLLNT)+1,^TMP($J,"YSCLDATA",YSCLLNT)=" Linked Tests:" 41 ;S YSCLLNT=$G(YSCLLNT)+1,^TMP($J,"YSCLDATA",YSCLLNT)="WBC = "_$$GET1^DIQ(603.02,1,.01)_", Neut% = "_$$GET1^DIQ(603.02,1,1) 42 S YSCLLNT=$G(YSCLLNT)+1,^TMP($J,"YSCLDATA",YSCLLNT)=" Monitored Drug - Monitor Routine - NDC - Lab Test" 43 S YSPR=0 F S YSPR=$O(^PSDRUG(YSPR)) Q:'YSPR I $P($G(^PSDRUG(YSPR,"CLOZ1")),"^")]"" D 44 . S YSCLTC=$P($G(^PSDRUG(YSPR,"CLOZ")),"^") I YSCLTC S YSCLTC=$$GET1^DIQ(60,YSCLTC,.01) 45 . S YSCLLNT=$G(YSCLLNT)+1,^TMP($J,"YSCLDATA",YSCLLNT)=$P($G(^PSDRUG(YSPR,0)),"^")_" - "_$P(^PSDRUG(YSPR,"CLOZ1"),"^")_" - "_$P($G(^PSDRUG(YSPR,2)),"^",4)_" - "_YSCLTC 46 S YSCLDR=0 F S YSCLDR=$O(^PSDRUG(YSCLDR)) Q:'YSCLDR I $D(^PSDRUG(YSCLDR,"CLOZ2")) D 47 . S YSCLDRA=0 F S YSCLDRA=$O(^PSDRUG(YSCLDR,"CLOZ2",YSCLDRA)) Q:'YSCLDRA D 48 . . S YSCLDRB=^PSDRUG(YSCLDR,"CLOZ2",YSCLDRA,0) 49 . . S YSCLLNT=$G(YSCLLNT)+1,^TMP($J,"YSCLDATA",YSCLLNT)=$P(^PSDRUG(YSCLDR,0),"^")_" uses "_$P(^LAB(60,$P(YSCLDRB,"^"),0),"^")_" to indicate "_$S($P(YSCLDRB,"^",4)=1:"White Blood Count",1:"Neutrophil Count") 50 ;D OPTION^%ZTLOAD("YSCL WEEKLY TRANSMISSION","LIST") D 51 ; . S ZTSK="" F S ZTSK=$O(LIST(ZTSK)) Q:ZTSK="" D 52 ; . . D STAT^%ZTLOAD S YSCLLNT=$G(YSCLLNT)+1,^TMP($J,"YSCLDATA",YSCLLNT)="Local Task # "_ZTSK_" is "_$S('ZTSK(0):" not ",1:"")_"defined with a status of "_ZTSK(2) 53 S YSCLLNT=$G(YSCLLNT)+1,^TMP($J,"YSCLDATA",YSCLLNT)=" Run day is: "_$P(^YSCL(603.03,1,0),"^",2) 54 S YSCLLNT=$G(YSCLLNT)+1,^TMP($J,"YSCLDATA",YSCLLNT)=" Debug Mode is: "_$S($P(^YSCL(603.03,1,0),"^",3):"On.",1:"Off.") 55 S YSCLLNT=$G(YSCLLNT)+1,^TMP($J,"YSCLDATA",YSCLLNT)="Last Run Date (start) is: "_$$FMTE^XLFDT($P(^YSCL(603.03,1,0),"^",4)) 56 S YSCLLNT=$G(YSCLLNT)+1,^TMP($J,"YSCLDATA",YSCLLNT)=" Last Run Date (stop) is: "_$$FMTE^XLFDT($P(^YSCL(603.03,1,0),"^",5)) 57 S YSCLLNT=$G(YSCLLNT)+1,^TMP($J,"YSCLDATA",YSCLLNT)="Last Demographic date is: "_$$FMTE^XLFDT($P(^YSCL(603.03,1,0),"^",6)) 58 Q 59 OUT S YSCLLNT=$G(YSCLLNT)+1,^TMP($J,"YSCLDATA",YSCLLNT)=XMRG_YSCLER_YSCLST Q 60 ;Build the text for the return message here. 61 REBUILD ; 62 S XMRG="",(YSCLA,YSCLLNT)=1 F S YSCLA=$O(^PS(55,"ASAND1",YSCLA)) W:'$D(ZTQUEUED) "." Q:YSCLA="" D 63 . S YSCLB=$O(^PS(55,"ASAND1",YSCLA,"")) I YSCLB="" S YSCLER=" record is in error (1) at " D OUT Q 64 . I '$D(^PS(55,YSCLB,0)) S YSCLER=" record is in error (2) at " D OUT Q 65 . S YSCLB=$P(^PS(55,YSCLB,0),"^") I YSCLB="" S YSCLER=" record is in error (3) at " D OUT Q 66 . I '$D(^PS(55,YSCLB,"SAND")) S YSCLER=" record is in error (4) at " D OUT Q 67 . S DIC="^DPT(",DIC(0)="X",D="SSN",(YSCLSSN,X)=$P(^DPT(YSCLB,0),"^",9) 68 . I $D(^YSCL(603.01,"B",YSCLA)) S YSCLX=$O(^YSCL(603.01,"B",YSCLA,"")) S:YSCLX]"" YSCLX=$P(^YSCL(603.01,YSCLX,0),"^",2),YSCLER=" Clozapine # "_YSCLA_" is in use by "_$P($G(^DPT(YSCLX,0)),"^")_" at " D OUT Q 69 . D MIX^DIC1 S YSCLPT=+Y I Y=-1 S YSCLER=" could not be added at " D OUT Q 70 . K DD S DIC="^YSCL(603.01,",X=YSCLA,DIC("DR")="1////"_YSCLPT K DO D FILE^DICN 71 . S YSCLX=$O(^YSCL(603.01,"B",YSCLA,"")) S:YSCLX]"" YSCLX=$P(^YSCL(603.01,YSCLX,0),"^",2),YSCLER=","_YSCLSSN_" assigned to "_$P($G(^DPT(YSCLX,0)),"^")_" at " D OUT 72 Q 73 OVRRID ;Update record with Monthly, Weekly or Bi-weekly status 74 F X XMREC Q:XMER<0 S XMRG=$TR(XMRG,"- ","") D 75 . I XMRG'?2U5N1","9N1",".E S YSCLER=" is in error and was not added at " D OUT Q 76 . I $P(XMRG,",")'?2U5N S YSCLER=" is not a valid Clozapine number format " D OUT Q 77 . I $P(XMRG,",",2)'?9N S YSCLER=" An SSN must be 9 numbers " D OUT Q 78 . K %DT S X=$P(XMRG,",",3),%DT="F" D ^%DT I Y=-1 S YSCLER=" is an invalid date, over-ride authorization not filed at " D OUT Q 79 . S YSCLOVR=Y 80 . S YSCLNM=$P(XMRG,","),YSCLSSN=$P(XMRG,",",2),YSCLWB=$P(XMRG,",",3) 81 . I '$D(^YSCL(603.01,"B",YSCLNM)) S YSCLER=" does not exist at " D OUT Q 82 . S YSCLDA=$O(^DPT("SSN",YSCLSSN,0)) 83 . I YSCLDA="" S YSCLER=" SSN does not exist at " D OUT Q 84 . I $O(^YSCL(603.01,"B",YSCLNM,0))="" S YSCLER=" SSN not in Clozapine file " D OUT Q 85 . I $O(^DPT("SSN",YSCLSSN,YSCLDA)) S YSCLER=" SSN has more than one owner " D OUT Q 86 . I $O(^YSCL(603.01,"B",YSCLNM,0))'=$O(^YSCL(603.01,"C",YSCLDA,0)) S YSCLER=" SSN ("_YSCLSSN_","_$P(^DPT(YSCLDA,0),"^")_") has multiple Clozapine Numbers at " D OUT 87 . I $O(^YSCL(603.01,"B",YSCLNM,0))=$O(^YSCL(603.01,"C",YSCLDA,0)) D 88 . . S YSCLDA1=$O(^YSCL(603.01,"B",YSCLNM,0)) S $P(^YSCL(603.01,YSCLDA1,0),"^",4)=YSCLOVR 89 . . S Y=YSCLOVR D DD^%DT S YSCLER=" "_YSCLNM_" ("_$P(^DPT(YSCLDA,0),"^")_") authorized for over-ride on "_Y_" at " D OUT 90 G EXIT^YSCLSERV 91 ZEOR ;YSCLSRV2 -
WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSCLSRV3.m
r613 r623 1 YSCLSRV3 2 ;;5.01;MENTAL HEALTH;**74,90,92**;Dec 30, 1994;Build 7 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 ACTIVE 26 27 28 DEMOG 29 30 31 32 33 34 35 36 LOCK 37 38 39 40 41 42 AUTH 43 44 . S ^TMP($J,"YSCLDATA",1)="The following providers are authorized to override Clozapine lockouts (PSOLOCKCLOZ)"45 46 47 48 49 50 51 52 . S ^TMP($J,"YSCLDATA",YSCLLN)="The following providers are authorized to access the Pharmacy Clozapine Manager Menu (PSZ CLOZAPINE)",YSCLLN=YSCLLN+153 54 55 56 57 58 59 . S ^TMP($J,"YSCLDATA",YSCLLN)="The following providers are authorized to prescribe Clozapine (YSCL AUTHORIZED)",YSCLLN=YSCLLN+160 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 ZEOR 1 YSCLSRV3 ;DALOI/RLM-Clozapine data server ;24 APR 1990 2 ;;5.01;MENTAL HEALTH;**74,90**;Dec 30, 1994;Build 18 3 ; Reference to ^%ZOSF supported by IA #10096 4 ; Reference to ^DPT supported by IA #10035 5 ; Reference to ^PS(55 supported by IA #787 6 ; Reference to ^PSDRUG supported by IA #25 7 ; Reference to ^PSRX supported by IA #780 8 ; Reference to ^VA(200 supported by IA #10060 9 ; Reference to ^XUSEC supported by IA #10076 10 ; 11 S ^TMP($J,"YSCLDATA",1)="This routine will print a list of all active Clozapine prescriptions." 12 S ^TMP($J,"YSCLDATA",2)="An asterisk in the first column indicates that the prescription is over" 13 S ^TMP($J,"YSCLDATA",3)="28 days old. The second column is the Patient Name. The third is the" 14 S ^TMP($J,"YSCLDATA",4)="Issue Date. The fourth column is the Prescription Number. The final" 15 S ^TMP($J,"YSCLDATA",5)="column is the CLOZAPINE STATUS indicator." 16 S X1=DT,X2=-28 D C^%DTC S YSCL28=X 17 S DFN=0,YSCLLN=6 18 F K YSCLA S DFN=$O(^PS(55,"ASAND",DFN)),YSCLLD=0 Q:'DFN I $D(^DPT(DFN,0)),$D(^PS(55,DFN,"SAND")) S YSCLSAND=^("SAND"),YSCL=^DPT(DFN,0),YSCLX=$E($P($P(YSCL,"^"),",",2))_$E(YSCL)_"^"_$P(YSCL,"^",9) D 19 . F YSCL=0:0 S YSCL=$O(^PS(55,DFN,"P",YSCL)) Q:'YSCL I $D(^(YSCL,0)) S YSCL1=^(0) I $D(^PSRX(YSCL1,0)) D ACTIVE I 'YSACT S YSCLRX=^PSRX(YSCL1,0) I $P($G(^PSDRUG(+$P(YSCLRX,"^",6),"CLOZ1")),"^")="PSOCLO1",$D(^("CLOZ")) S YSCLLAB=^("CLOZ") D 20 . . ;W !,DFN," - ",YSCL1 21 . . S ^TMP($J,"YSCLDATA",YSCLLN)=$S(YSCL28>$P(YSCLRX,"^",13):"*",1:" ")_"^"_$P(^DPT($P(YSCLRX,"^",2),0),"^")_"^"_$$FMTE^XLFDT($P(YSCLRX,"^",13))_"^"_$P(YSCLRX,"^")_"^"_$P(YSCLSAND,"^",2) 22 . . S YSCLLN=YSCLLN+1 23 G EXIT^YSCLSERV 24 Q 25 ACTIVE ; 26 S YSACT=$$GET1^DIQ(52,YSCL1_",",100,"I","ERR") 27 Q 28 DEMOG ; 29 S YSCLA=0 F S YSCLA=$O(^YSCL(603.01,"C",YSCLA)) Q:'YSCLA D 30 . I $D(^PS(55,YSCLA,"SAND")),$P(^PS(55,YSCLA,"SAND"),"^",4)=0 S YSCLC=$G(YSCLC)+1 31 . I $D(^PS(55,YSCLA,"SAND")),$P(^PS(55,YSCLA,"SAND"),"^",4) S $P(^PS(55,YSCLA,"SAND"),"^",4)=0,YSCLB=$G(YSCLB)+1 32 S ^TMP($J,"YSCLDATA",2)=+$G(YSCLB)_" record"_$S(+$G(YSCLB)=1:"",1:"s")_" reset at ("_YSCLST_") "_YSCLSTN 33 S ^TMP($J,"YSCLDATA",3)=+$G(YSCLC)_" record"_$S(+$G(YSCLC)=1:"",1:"s")_" not reset at ("_YSCLST_") "_YSCLSTN 34 G EXIT^YSCLSERV 35 Q 36 LOCK ;Lock out ability to dispense Clozapine 37 X XMREC Q:XMER<0 S X=XMRG 38 I X="LOCK DOWN ON" S $P(^YSCL(603.03,1,1),"^",1)=1 S YSCLLNT=$G(YSCLLNT)+1,^TMP($J,"YSCLDATA",YSCLLNT)="Clozapine dispensing prohibited at "_YSCLST 39 I X="LOCK DOWN OFF" S $P(^YSCL(603.03,1,1),"^",1)=0 S YSCLLNT=$G(YSCLLNT)+1,^TMP($J,"YSCLDATA",YSCLLNT)="Clozapine dispensing enabled at "_YSCLST 40 G EXIT^YSCLSERV 41 Q 42 AUTH ;List authorized Clozapine providers 43 I YSCLSUB["LIST" D G EXIT^YSCLSERV 44 . S ^TMP($J,"YSCLDATA",1)="The following providers are authorized to override Clozapine lockouts" 45 . S YSCLLN=2 46 . S YSCLA="" F S YSCLA=$O(^XUSEC("PSOLOCKCLOZ",YSCLA)) Q:YSCLA="" D 47 . . Q:'$D(^VA(200,YSCLA,0)) 48 . . S ^TMP($J,"YSCLDATA",YSCLLN)=$P(^VA(200,YSCLA,0),"^",1)_" "_$S($P(^VA(200,YSCLA,0),"^",7)=1:"Ina",1:"A")_"ctive",YSCLLN=YSCLLN+1 49 . S ^TMP($J,"YSCLDATA",YSCLLN)="",YSCLLN=YSCLLN+1 50 . S ^TMP($J,"YSCLDATA",YSCLLN)="",YSCLLN=YSCLLN+1 51 . S ^TMP($J,"YSCLDATA",YSCLLN)="",YSCLLN=YSCLLN+1 52 . S ^TMP($J,"YSCLDATA",YSCLLN)="The following providers are authorized to access the Pharmacy Clozapine Manager Menu",YSCLLN=YSCLLN+1 53 . S YSCLA="" F S YSCLA=$O(^XUSEC("PSZ CLOZAPINE",YSCLA)) Q:YSCLA="" D 54 . . Q:'$D(^VA(200,YSCLA,0)) 55 . . S ^TMP($J,"YSCLDATA",YSCLLN)=$P(^VA(200,YSCLA,0),"^",1)_" "_$S($P(^VA(200,YSCLA,0),"^",7)=1:"Ina",1:"A")_"ctive",YSCLLN=YSCLLN+1 56 . S ^TMP($J,"YSCLDATA",YSCLLN)="",YSCLLN=YSCLLN+1 57 . S ^TMP($J,"YSCLDATA",YSCLLN)="",YSCLLN=YSCLLN+1 58 . S ^TMP($J,"YSCLDATA",YSCLLN)="",YSCLLN=YSCLLN+1 59 . S ^TMP($J,"YSCLDATA",YSCLLN)="The following providers are authorized to prescribe Clozapine",YSCLLN=YSCLLN+1 60 . S YSCLA=0 F S YSCLA=$O(^XUSEC("YSCL AUTHORIZED",YSCLA)) Q:'YSCLA D ;??? Use FileMan lookup on 200 61 . . S YSCLDEA=$$DEA^XUSER(1,YSCLA),YSCLYN=1,YSCLSSN=$P(^VA(200,YSCLA,1),"^",9) 62 . . S ^TMP($J,"YSCLDATA",YSCLLN)=$P($G(^VA(200,YSCLA,0)),"^",1)_" - "_YSCLSSN_" - "_$S(YSCLDEA="":"*NONE*",1:YSCLDEA)_" - "_$S(YSCLYN=1:"Yes",1:"NO"),YSCLLN=YSCLLN+1 63 ;Holders of YSCL AUTHORIZED key 64 ;============================================= 65 ; 66 S YSCLLN=1,^TMP($J,"YSCLDATA",YSCLLN)="Clinician Authorization Results at "_YSCLST,YSCLLN=YSCLLN+1 67 K ^TMP("DIERR",$J) 68 F X XMREC Q:XMER<0 S X=XMRG X ^%ZOSF("UPPERCASE") S X=Y D 69 . S YSCLSSN=$P(X,"^",1),YSCLDEA=$P(X,"^",2),YSCLYN=$P(X,"^",3),YSCLDUZ="",YSCLDEA1="",YSCLIEN="" 70 . I YSCLLN=""!("YESNO"'[YSCLYN) S ^TMP($J,"YSCLDATA",YSCLLN)="Clinician Authorization instructions invalid ("_YSCLYN_") at "_YSCLST,YSCLLN=YSCLLN+1 71 . S YSCLYN=$S(YSCLYN="YES":1,1:0) 72 . I '$D(^VA(200,"BS5",YSCLSSN)) S ^TMP($J,"YSCLDATA",YSCLLN)="Clinician ("_YSCLSSN_") does not exist at "_YSCLST,YSCLLN=YSCLLN+1 Q 73 . I $D(^VA(200,"BS5",YSCLSSN)) S YSCLAA="" F S YSCLAA=$O(^VA(200,"BS5",YSCLSSN,YSCLAA)) Q:YSCLAA="" I $$DEA^XUSER(1,YSCLAA)=YSCLDEA S YSCLDUZ=YSCLAA Q 74 . I YSCLDUZ="" S ^TMP($J,"YSCLDATA",YSCLLN)="Clinician ("_YSCLSSN_") with DEA# "_YSCLDEA_" does not exist at "_YSCLST,YSCLLN=YSCLLN+1 Q 75 . S YSCLDEA1=$$DEA^XUSER(1,YSCLDUZ) 76 . I YSCLDEA1="" S ^TMP($J,"YSCLDATA",YSCLLN)="Clinician with DEA# "_YSCLDEA_" does not exist at "_YSCLST,YSCLLN=YSCLLN+1 Q 77 . I YSCLDEA'=YSCLDEA1 W ^TMP($J,"YSCLDATA",YSCLLN)="Clinician SSN ("_YSCLSSN_") - DEA ("_YSCLDEA_") mismatch at "_YSCLST,YSCLLN=YSCLLN+1 Q 78 . D OWNSKEY^XUSRB(.RET,"YSCL AUTHORIZED",YSCLDUZ) 79 . I RET(0),YSCLYN S ^TMP($J,"YSCLDATA",YSCLLN)="Clinician ("_YSCLSSN_") already authorized at "_YSCLST,YSCLLN=YSCLLN+1 Q 80 . I 'RET(0),'YSCLYN S ^TMP($J,"YSCLDATA",YSCLLN)="Clinician ("_YSCLSSN_") not authorized at "_YSCLST,YSCLLN=YSCLLN+1 Q 81 . I 'RET(0),YSCLYN S YSCLDUZ(0)=DUZ,DUZ(0)="@" D S DUZ(0)=YSCLDUZ(0) 82 . . S YSCLFDA(200,"?1,",.01)="`"_YSCLDUZ 83 . . S YSCLFDA(200.051,"+2,?1,",.01)="YSCL AUTHORIZED" D UPDATE^DIE("E","YSCLFDA",,"YSCLERR") 84 . . I $D(YSCLERR) S ^TMP($J,"YSCLDATA",YSCLLN)="Clinician SSN "_YSCLSSN_" authorization failed at "_YSCLST,YSCLLN=YSCLLN+1 Q 85 . . I '$D(YSCLERR) S ^TMP($J,"YSCLDATA",YSCLLN)="Clinician SSN "_YSCLSSN_" authorization set to "_$S(YSCLYN=1:"Yes",1:"No")_" at "_YSCLST,YSCLLN=YSCLLN+1 Q 86 . I RET(0),'YSCLYN S YSCLDUZ(0)=DUZ,DUZ(0)="@" D S DUZ(0)=YSCLDUZ(0) 87 . . S DA=$$FIND1^DIC(200.051,","_YSCLDUZ_",","A","YSCL AUTHORIZE") 88 . . I DA<1 S ^TMP($J,"YSCLDATA",YSCLLN)="Clinician SSN "_YSCLSSN_" authorization removal failed at "_YSCLST,YSCLLN=YSCLLN+1 Q 89 . . S DA(1)=YSCLDUZ,DIK="^VA(200,"_DA(1)_",51," D ^DIK 90 . . S ^TMP($J,"YSCLDATA",YSCLLN)="Clinician SSN "_YSCLSSN_" authorization removed at "_YSCLST,YSCLLN=YSCLLN+1 Q 91 G EXIT^YSCLSERV 92 Q 93 ZEOR ;YSCLSRV3 -
WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSCLTST2.m
r613 r623 1 YSCLTST2 ;DALOI/LB/RLM-TRANSMIT RX AND lAB DATA FOR CLOZAPINE ;19 Feb 93 2 ;;5.01;MENTAL HEALTH;**18,22,26,47,61,69,74,90,92**;Dec 30, 1994;Build 7 3 ; Reference to ^LAB(60 supported by IA #333 4 ; Reference to ^PSDRUG supported by IA #25 5 ; Reference to ^XMD supported by IA #10070 6 ; 7 TRANSMIT ; send remote and local, kill and quit 8 K XMZ S %DT="T",X="NOW" D ^%DT S YSCLNOW=$P(Y,".",2),YSCLSITE=$P($$SITE^VASITE,"^",2) 9 S $P(YSSTOP,",",7)=7 I $$S^%ZTLOAD D ABORT^YSCLTEST G END 10 I YSCLLN D 11 . K XMY 12 . S XMY("S.RUCLRXLAB@FO-HINES.MED.VA.GOV")="" 13 . I YSDEBUG K XMY S XMY("G.CLOZAPINE DEBUG@FO-DALLAS.MED.VA.GOV")="",XMY("G.RUCLRXLAB@FO-DALLAS.MED.VA.GOV")="" 14 . S XMDUZ="Clozapine MONITOR",XMTEXT="^TMP($J,",XMSUB=$S(YSDEBUG:"DEBUG ",1:"")_"Clozapine lab data @ "_YSCLSITE_" on "_DT_" at "_YSCLNOW D ^XMD 15 K XMY 16 S XMY("G.CLOZAPINE ROLL-UP@FORUM.VA.GOV")="" 17 I YSDEBUG K XMY S XMY("G.CLOZAPINE DEBUG@FO-DALLAS.MED.VA.GOV")="" 18 S XMY("G.PSOCLOZ")="" 19 S XMSUB=$S(YSDEBUG:"DEBUG ",1:"")_"Clozapine lab data @ "_YSCLSITE_" on "_DT_" at "_YSCLNOW 20 S ^TMP("YSCL",$J,2,0)=" ",^TMP("YSCL",$J,3,0)="In message # "_$S($D(XMZ):XMZ,1:"no data sent") 21 K XMZ S XMDUZ="Clozapine MONITOR",^TMP("YSCL",$J,1,0)="Clozapine lab data was transmitted, "_(YSCLLLN-3)_" records were sent",XMTEXT="^TMP(""YSCL"",$J," D ^XMD 22 S $P(^YSCL(603.03,1,0),"^",5)=$$NOW^XLFDT 23 END ; 24 G END1^YSCLTST3 25 Q 26 REXMIT ; retransmit lab and RX data 27 ; must be a tuesday 28 S DIR(0)="Y",DIR("A")="Are you sure you wish to retransmit lab data" 29 D ^DIR K DIR I Y'=1 K Y Q 30 DATE S %DT="AEXP",%DT(0)=-DT,%DT("A")="Ending date for data collection (must be a tuesday )" 31 D ^%DT K %DT G END:X="^",END:X="^" I Y=-1 G DATE 32 SERV S YSCLED=Y,X=Y D H^%DTC I %H#7'=5 W !,"MUST BE A TUESDAY" G DATE 33 S ZTDESC="Server triggered retransmission" 34 S ZTSAVE("YSCLED")="",ZTIO="",ZTRTN="REXMIT^YSCLTEST",ZTDTH=$H D ^%ZTLOAD G END 35 FLSET ;Set up file 603.02 36 W @IOF,"This option specifies the blood tests associated with the Clozapine" 37 W !,"reporting software. Two tests must be defined. The first is the White" 38 W !,"Blood Count. The second is the Granulocyte (or Neutrophil) percentage." 39 K DIR W !! S DIR(0)="PA^64:EMZ",DIR("A",1)="Enter the test that will be used to record the White Blood Count for the",DIR("A")="Clozapine patients: " D ^DIR 40 Q:Y=-1!($D(DUOUT))!($D(DTOUT))!($D(DIRUT))!($D(DIROUT)) 41 S YSCLWBC=+Y 42 K DIR W !! S DIR(0)="PA^64:EMZ",DIR("A",1)="Enter the test that will be used to record the Neutrophil Count (percentage)",DIR("A")=" for the Clozapine patients: " D ^DIR 43 Q:Y=-1!($D(DUOUT))!($D(DTOUT))!($D(DIRUT))!($D(DIROUT)) 44 S YSCLGRN=+Y 45 I YSCLWBC,YSCLGRN S ^YSCL(603.02,1,0)=YSCLWBC_"^"_YSCLGRN,$P(^YSCL(603.02,0),"^",3,4)="1^1" 46 ;Only one entry is allowed. 47 K DIR,X,Y,YSCLWBC,YSCLGRN,ZTDESC 48 Q 49 EN(DRG) ; 50 K LAB I $P($G(^PSDRUG(DRG,"CLOZ1")),"^")'="PSOCLO1" S LAB("NOT")=0 Q 51 I $P($G(^PSDRUG(DRG,"CLOZ1")),"^")="PSOCLO1" D 52 . S (CNT,I)=0 F S I=$O(^PSDRUG(DRG,"CLOZ2",I)) Q:'I S CNT=$G(CNT)+1 53 . I CNT'=2 S LAB("BAD TEST")=0 K CNT Q 54 . K CNT F I=0:0 S I=$O(^PSDRUG(DRG,"CLOZ2",I)) Q:'I D 55 . . S LABT=$S($P(^PSDRUG(DRG,"CLOZ2",I,0),"^",4)=1:"WBC",1:"ANC"),LAB(LABT)=$P(^PSDRUG(DRG,"CLOZ2",I,0),"^")_"^"_$P(^(0),"^",3)_"^"_$P(^(0),"^",4) 56 K LABT,I 57 Q 58 CL1(DFN,DAYS) ;The routine was split due to size 59 G CL1^YSCLTST4 60 Q 61 ; 62 CL(DFN) ; 63 K ^TMP("LRRR",$J) N RESULTS,YSCLYWBC,YSCLRANC,YSCLXWBC,YSCLRWBC,YSCLFRQ 64 I 'DFN Q "-1^-1^-1^-1^-1^-1^-1" 65 S YSCLFRQ=$O(^YSCL(603.01,"C",DFN,"")) I YSCLFRQ]"" S YSCLFRQ=$P(^YSCL(603.01,YSCLFRQ,0),"^",3) 66 I $G(^YSCL(603.03,1,1))=1!(YSCLFRQ="") Q "-1^0^0^0^0^0^"_YSCLFRQ 67 S X1=DT,X2="-7" D C^%DTC S YSCLSD=X 68 S YSCLA=0 F S YSCLA=$O(^YSCL(603.04,1,1,YSCLA)) Q:'YSCLA S YSCLTLS=^YSCL(603.04,1,1,YSCLA,0),YSCLTLS($P(YSCLTLS,"^",2),$P(YSCLTLS,"^",1))=$P(YSCLTLS,"^",3) 69 S YSCLTL="" F S YSCLTL=$O(^YSCL(603.04,1,1,"B",YSCLTL)) Q:'YSCLTL D 70 . D RR^LR7OR1(DFN,,YSCLSD,DT,,YSCLTL,"L") 71 . S YSCLSB1="" F S YSCLSB1=$O(^TMP("LRRR",$J,DFN,YSCLSB1)) Q:YSCLSB1="" D 72 . . S YSCLTDT="" F S YSCLTDT=$O(^TMP("LRRR",$J,DFN,YSCLSB1,YSCLTDT)) Q:YSCLTDT="" I $P(YSCLTDT,".",2)]"" D 73 . . . S YSCLTA="" F S YSCLTA=$O(^TMP("LRRR",$J,DFN,YSCLSB1,YSCLTDT,YSCLTA)) Q:YSCLTA="" I YSCLTA D 74 . . . . S RESULTS1=^TMP("LRRR",$J,DFN,YSCLSB1,YSCLTDT,YSCLTA) 75 . . . . S RESULTS(YSCLTL,YSCLTDT)=$P(RESULTS1,"^",2) 76 ;Find all entries for WBC and sort by inverse date. 77 S YSCLA="" F S YSCLA=$O(YSCLTLS("W",YSCLA)) Q:'YSCLA S YSCLXWBC(YSCLA)="" D 78 . S YSCLA1="" F S YSCLA1=$O(RESULTS(YSCLA,YSCLA1)) Q:'YSCLA1 S YSCLYWBC(YSCLA1)=RESULTS(YSCLA,YSCLA1)_"^"_$P($G(^LAB(60,YSCLA,0)),"^")_"^"_YSCLTLS("W",YSCLA) 79 S YSCLRWBC=$O(YSCLYWBC(0)) I 'YSCLRWBC D KILL Q "0^^^^^^"_YSCLFRQ 80 S YSCLMULT=$P(YSCLYWBC(YSCLRWBC),"^",3),YSCLMULT=$S(YSCLMULT:1000,1:1) 81 S YSCLRWBC(YSCLRWBC)=($P(YSCLYWBC(YSCLRWBC),"^")*YSCLMULT)_"^"_$P(YSCLYWBC(YSCLRWBC),"^",2) 82 ;Scan for Neutrophil count on same day and time as most recent WBC 83 S YSCLMTCH=0 F YSCLA="A","N","S","T" S YSCLTPT="" Q:YSCLMTCH F S YSCLTPT=$O(YSCLTLS(YSCLA,YSCLTPT)) Q:'YSCLTPT D Q:YSCLMTCH 84 . S YSCLMULT=YSCLTLS(YSCLA,YSCLTPT),YSCLMULT=$S(YSCLMULT:1000,1:1) 85 . I $D(RESULTS(YSCLTPT,YSCLRWBC)),YSCLA="A",RESULTS(YSCLTPT,YSCLRWBC)'?1A.E S YSCLMTCH=1,YSCLRANC(YSCLRWBC)=RESULTS(YSCLTPT,YSCLRWBC)*YSCLMULT_"^"_$P(^LAB(60,YSCLTPT,0),"^") Q 86 . I $D(RESULTS(YSCLTPT,YSCLRWBC)),YSCLA="N",RESULTS(YSCLTPT,YSCLRWBC)'?1A.E S YSCLMTCH=1,YSCLRANC(YSCLRWBC)=YSCLRWBC(YSCLRWBC)*((RESULTS(YSCLTPT,YSCLRWBC))*.01)_"^"_$P(^LAB(60,YSCLTPT,0),"^") Q 87 . I $D(RESULTS(YSCLTPT,YSCLRWBC)),YSCLA="S",RESULTS(YSCLTPT,YSCLRWBC)'?1A.E D 88 . . S YSCLSGS="" F S YSCLSGS=$O(YSCLTLS("B",YSCLSGS)) D Q:YSCLMTCH 89 . . . S:'YSCLSGS YSCLSGS="Z" I '$D(RESULTS(YSCLSGS,YSCLRWBC)) S RESULTS(YSCLSGS,YSCLRWBC)=0 90 . . . S YSCLMTCH=1,YSCLRANC(YSCLRWBC)=YSCLRWBC(YSCLRWBC)*((RESULTS(YSCLTPT,YSCLRWBC)*.01)+(RESULTS(YSCLSGS,YSCLRWBC)*.01))_"^"_$P(^LAB(60,YSCLTPT,0),"^")_"/"_$P($G(^LAB(60,YSCLSGS,0)),"^") Q 91 . I $D(RESULTS(YSCLTPT,YSCLRWBC)),YSCLA="C",RESULTS(YSCLTPT,YSCLRWBC)'?1A.E D 92 . . S YSCLSGS="" F S YSCLSGS=$O(YSCLTLS("T",YSCLSGS)) D Q:YSCLMTCH 93 . . . S:'YSCLSGS YSCLSGS="Z" I '$D(RESULTS(YSCLSGS,YSCLRWBC)) S RESULTS(YSCLSGS,YSCLRWBC)=0 94 . . . S YSCLMTCH=1,YSCLRANC(YSCLRWBC)=((RESULTS(YSCLTPT,YSCLRWBC)*YSCLMULT)+(RESULTS(YSCLSGS,YSCLRWBC)*YSCLMULT))_"^"_$P(^LAB(60,YSCLTPT,0),"^")_"/"_$P($G(^LAB(60,YSCLSGS,0)),"^") Q 95 D KILL 96 I $G(YSCLRWBC(YSCLRWBC))<3000!($G(YSCLRANC(YSCLRWBC))<1500) Q "0^"_$G(YSCLRWBC(YSCLRWBC))_"^"_$S($G(YSCLRANC(YSCLRWBC))="":"^",1:$G(YSCLRANC(YSCLRWBC)))_"^"_(9999999-YSCLRWBC)_"^"_YSCLFRQ 97 I $G(YSCLRWBC(YSCLRWBC))<3500!($G(YSCLRANC(YSCLRWBC))<2000) Q "2^"_$G(YSCLRWBC(YSCLRWBC))_"^"_$S($G(YSCLRANC(YSCLRWBC))="":"^",1:$G(YSCLRANC(YSCLRWBC)))_"^"_(9999999-YSCLRWBC)_"^"_YSCLFRQ 98 Q "1^"_YSCLRWBC(YSCLRWBC)_"^"_YSCLRANC(YSCLRWBC)_"^"_(9999999-YSCLRWBC)_"^"_YSCLFRQ 99 ; 100 KILL ; 101 K FDA,YSCLSGS,Y15,RESULTS,RESULTS1,YSCLA,YSCLA1,YSCLMTCH,YSCLSB1,YSCLSD,YSCLTA,YSCLMULT 102 K YSCLTL,YSCLTLS,X1,X2 103 Q 104 ; 105 OVERRIDE(DFN) ;Check for an over-ride. 106 S YSCLOVR=$O(^YSCL(603.01,"C",DFN,"")) 107 Q:YSCLOVR="" 0 108 S YSCLOVR=$P(^YSCL(603.01,YSCLOVR,0),"^",4) 109 Q YSCLOVR=DT 110 ; 111 ZEOR ;YSCLTST2 1 YSCLTST2 ;DALOI/LB/RLM-TRANSMIT RX AND lAB DATA FOR CLOZAPINE ;19 Feb 93 2 ;;5.01;MENTAL HEALTH;**18,22,26,47,61,69,74,90**;Dec 30, 1994;Build 18 3 ; Reference to ^LAB(60 supported by IA #333 4 ; Reference to ^PSDRUG supported by IA #25 5 ; Reference to ^XMD supported by IA #10070 6 ; 7 TRANSMIT ; send remote and local, kill and quit 8 K XMZ S %DT="T",X="NOW" D ^%DT S YSCLNOW=$P(Y,".",2),YSCLSITE=$P($$SITE^VASITE,"^",2) 9 S $P(YSSTOP,",",7)=7 I $$S^%ZTLOAD D ABORT^YSCLTEST G END 10 I YSCLLN D 11 . K XMY 12 . S XMY("S.RUCLRXLAB@FO-HINES.MED.VA.GOV")="" 13 . I YSDEBUG K XMY S XMY("G.CLOZAPINE DEBUG@FO-DALLAS.MED.VA.GOV")="",XMY("G.RUCLRXLAB@FO-DALLAS.MED.VA.GOV")="" 14 . S XMDUZ="Clozapine MONITOR",XMTEXT="^TMP($J,",XMSUB=$S(YSDEBUG:"DEBUG ",1:"")_"Clozapine lab data @ "_YSCLSITE_" on "_DT_" at "_YSCLNOW D ^XMD 15 K XMY 16 S XMY("G.CLOZAPINE ROLL-UP@FORUM.VA.GOV")="" 17 I YSDEBUG K XMY S XMY("G.CLOZAPINE DEBUG@FO-DALLAS.MED.VA.GOV")="" 18 S XMY("G.PSOCLOZ")="" 19 S XMSUB=$S(YSDEBUG:"DEBUG ",1:"")_"Clozapine lab data @ "_YSCLSITE_" on "_DT_" at "_YSCLNOW 20 S ^TMP("YSCL",$J,2,0)=" ",^TMP("YSCL",$J,3,0)="In message # "_$S($D(XMZ):XMZ,1:"no data sent") 21 K XMZ S XMDUZ="Clozapine MONITOR",^TMP("YSCL",$J,1,0)="Clozapine lab data was transmitted, "_(YSCLLLN-3)_" records were sent",XMTEXT="^TMP(""YSCL"",$J," D ^XMD 22 S $P(^YSCL(603.03,1,0),"^",5)=$$NOW^XLFDT 23 END ; 24 G END1^YSCLTST3 25 Q 26 REXMIT ; retransmit lab and RX data 27 ; must be a period ending on tuesday 28 S DIR(0)="Y",DIR("A")="Are you sure you wish to retransmit lab data" 29 D ^DIR K DIR I Y'=1 K Y Q 30 DATE S %DT="AEXP",%DT(0)=-DT,%DT("A")="Ending date for data collection (must be a tuesday )" 31 D ^%DT K %DT G END:X="^",END:X="^" I Y=-1 G DATE 32 SERV S YSCLED=Y,X=Y D H^%DTC I %H#7'=5 W !,"MUST BE A TUESDAY" G DATE 33 S ZTDESC="Server triggered retransmission" 34 S ZTSAVE("YSCLED")="",ZTIO="",ZTRTN="REXMIT^YSCLTEST",ZTDTH=$H D ^%ZTLOAD G END 35 FLSET ;Set up file 603.02 36 W @IOF,"This option specifies the blood tests associated with the Clozapine" 37 W !,"reporting software. Two tests must be defined. The first is the White" 38 W !,"Blood Count. The second is the Granulocyte (or Neutrophil) percentage." 39 K DIR W !! S DIR(0)="PA^64:EMZ",DIR("A",1)="Enter the test that will be used to record the White Blood Count for the",DIR("A")="Clozapine patients: " D ^DIR 40 Q:Y=-1!($D(DUOUT))!($D(DTOUT))!($D(DIRUT))!($D(DIROUT)) 41 S YSCLWBC=+Y 42 K DIR W !! S DIR(0)="PA^64:EMZ",DIR("A",1)="Enter the test that will be used to record the Neutrophil Count (percentage)",DIR("A")=" for the Clozapine patients: " D ^DIR 43 Q:Y=-1!($D(DUOUT))!($D(DTOUT))!($D(DIRUT))!($D(DIROUT)) 44 S YSCLGRN=+Y 45 I YSCLWBC,YSCLGRN S ^YSCL(603.02,1,0)=YSCLWBC_"^"_YSCLGRN,$P(^YSCL(603.02,0),"^",3,4)="1^1" 46 ;Only one entry is allowed. No cross reference is necessary. Update zeroeth node RLM 9-29-99 47 K DIR,X,Y,YSCLWBC,YSCLGRN,ZTDESC 48 Q 49 EN(DRG) ; 50 K LAB I $P($G(^PSDRUG(DRG,"CLOZ1")),"^")'="PSOCLO1" S LAB("NOT")=0 Q 51 I $P($G(^PSDRUG(DRG,"CLOZ1")),"^")="PSOCLO1" D 52 . S (CNT,I)=0 F S I=$O(^PSDRUG(DRG,"CLOZ2",I)) Q:'I S CNT=$G(CNT)+1 53 . I CNT'=2 S LAB("BAD TEST")=0 K CNT Q 54 . K CNT F I=0:0 S I=$O(^PSDRUG(DRG,"CLOZ2",I)) Q:'I D 55 . . S LABT=$S($P(^PSDRUG(DRG,"CLOZ2",I,0),"^",4)=1:"WBC",1:"ANC"),LAB(LABT)=$P(^PSDRUG(DRG,"CLOZ2",I,0),"^")_"^"_$P(^(0),"^",3)_"^"_$P(^(0),"^",4) 56 K LABT,I 57 Q 58 CL1(DFN,DAYS) ; 59 K ^TMP($J,"PSO"),RESULTS,YSCLYWBC,YSCLRANC,YSCLXWBC 60 Q:'DFN 61 S:'$G(DAYS) DAYS=90 62 S YSCLFRQ=$O(^YSCL(603.01,"C",DFN,"")) I YSCLFRQ]"" S YSCLFRQ=$P(^YSCL(603.01,YSCLFRQ,0),"^",3) 63 I $G(^YSCL(603.03,1,1))=1 Q "-1^0^0^0^0^0^"_YSCLFRQ 64 S X1=DT,X2="-"_DAYS D C^%DTC S YSCLSD=X 65 S YSCLA=0 F S YSCLA=$O(^YSCL(603.04,1,1,YSCLA)) Q:'YSCLA S YSCLTLS=^YSCL(603.04,1,1,YSCLA,0),YSCLTLS($P(YSCLTLS,"^",2),$P(YSCLTLS,"^",1))=$P(YSCLTLS,"^",3) 66 S YSCLTL="" F S YSCLTL=$O(^YSCL(603.04,1,1,"B",YSCLTL)) Q:'YSCLTL D 67 . D RR^LR7OR1(DFN,,YSCLSD,DT,,YSCLTL,"L") 68 . S YSCLSB1="" F S YSCLSB1=$O(^TMP("LRRR",$J,DFN,YSCLSB1)) Q:YSCLSB1="" D 69 . . S YSCLTDT="" F S YSCLTDT=$O(^TMP("LRRR",$J,DFN,YSCLSB1,YSCLTDT)) Q:YSCLTDT="" I $P(YSCLTDT,".",2)]"" D 70 . . . S YSCLTA="" F S YSCLTA=$O(^TMP("LRRR",$J,DFN,YSCLSB1,YSCLTDT,YSCLTA)) Q:YSCLTA="" I YSCLTA D 71 . . . . S RESULTS1=^TMP("LRRR",$J,DFN,YSCLSB1,YSCLTDT,YSCLTA) 72 . . . . S RESULTS(YSCLTL,YSCLTDT)=$P(RESULTS1,"^",2) 73 ;Find all entries for WBC and sort by inverse date. 74 S YSCLA="" F S YSCLA=$O(YSCLTLS("W",YSCLA)) Q:'YSCLA S YSCLXWBC(YSCLA)="" D 75 . S YSCLA1="" F S YSCLA1=$O(RESULTS(YSCLA,YSCLA1)) Q:'YSCLA1 S YSCLYWBC(YSCLA1)=RESULTS(YSCLA,YSCLA1)*$S(YSCLTLS("W",YSCLA):1000,1:1) 76 S YSCLRWBC=0 F S YSCLRWBC=$O(YSCLYWBC(YSCLRWBC)) Q:YSCLRWBC="" S YSCLRWBC(YSCLRWBC)=YSCLYWBC(YSCLRWBC) D 77 . ;Match all ANC's and WBC's 78 . S YSCLMTCH=0 F YSCLA="A","N","S","C" S YSCLTPT="" F S YSCLTPT=$O(YSCLTLS(YSCLA,YSCLTPT)) Q:'YSCLTPT D 79 . . I $D(RESULTS(YSCLTPT,YSCLRWBC)),YSCLA="A",$D(YSCLRWBC(YSCLRWBC)) S ^TMP($J,"PSO",YSCLRWBC)=YSCLRWBC(YSCLRWBC)_"^"_(RESULTS(YSCLTPT,YSCLRWBC)*$S(YSCLTLS(YSCLA,YSCLTPT):1000,1:1)) Q 80 . . I $D(RESULTS(YSCLTPT,YSCLRWBC)),YSCLA="N",$D(YSCLRWBC(YSCLRWBC)) S ^TMP($J,"PSO",YSCLRWBC)=YSCLRWBC(YSCLRWBC)_"^"_(YSCLRWBC(YSCLRWBC)*((RESULTS(YSCLTPT,YSCLRWBC)*.01))) Q 81 . . I $D(RESULTS(YSCLTPT,YSCLRWBC)),YSCLA="S",$D(YSCLRWBC(YSCLRWBC)) D 82 . . . S YSCLSGS="" F S YSCLSGS=$O(YSCLTLS("B",YSCLSGS)) D Q:'YSCLSGS 83 . . . . S:'YSCLSGS YSCLSGS="Z" I '$D(RESULTS(YSCLSGS,YSCLRWBC)) S RESULTS(YSCLSGS,YSCLRWBC)=0 84 . . . . S ^TMP($J,"PSO",YSCLRWBC)=YSCLRWBC(YSCLRWBC)_"^"_(YSCLRWBC(YSCLRWBC)*((RESULTS(YSCLTPT,YSCLRWBC)*.01)+(RESULTS(YSCLSGS,YSCLRWBC)*.01))) Q 85 . . I $D(RESULTS(YSCLTPT,YSCLRWBC)),YSCLA="C" D 86 . . . S YSCLSGS="" F S YSCLSGS=$O(YSCLTLS("T",YSCLSGS)) D Q:'YSCLSGS 87 . . . . S:'YSCLSGS YSCLSGS="Z" I '$D(RESULTS(YSCLSGS,YSCLRWBC)) S RESULTS(YSCLSGS,YSCLRWBC)=0 88 . . . . S ^TMP($J,"PSO",YSCLRWBC)=YSCLRWBC(YSCLRWBC)_"^"_((RESULTS(YSCLTPT,YSCLRWBC)*$S(YSCLTLS(YSCLA,YSCLTPT):1000,1:1))+(RESULTS(YSCLSGS,YSCLRWBC))) Q 89 K FDA,YSCLSGS,Y15,YSCLRWBC,YSCLANC,YSCLYWBC,YSCLFRQ,ZIENS,RESULTS,RESULTS1,YSCLA,YSCLA1,YSCLMTCH,YSCLSB1,YSCLSD 90 K YSCLTA,YSCLTDT,YSCLTL,YSCLTLS,YSCLTPT,YSCLXWBC,YSCLMULT 91 Q 92 ; 93 ; 94 CL(DFN) ; 95 K ^TMP("LRRR",$J) N RESULTS,YSCLYWBC,YSCLRANC,YSCLXWBC,YSCLRWBC,YSCLFRQ 96 I 'DFN Q "-1^-1^-1^-1^-1^-1^-1" 97 S YSCLFRQ=$O(^YSCL(603.01,"C",DFN,"")) I YSCLFRQ]"" S YSCLFRQ=$P(^YSCL(603.01,YSCLFRQ,0),"^",3) 98 I $G(^YSCL(603.03,1,1))=1!(YSCLFRQ="") Q "-1^0^0^0^0^0^"_YSCLFRQ 99 S X1=DT,X2="-7" D C^%DTC S YSCLSD=X 100 S YSCLA=0 F S YSCLA=$O(^YSCL(603.04,1,1,YSCLA)) Q:'YSCLA S YSCLTLS=^YSCL(603.04,1,1,YSCLA,0),YSCLTLS($P(YSCLTLS,"^",2),$P(YSCLTLS,"^",1))=$P(YSCLTLS,"^",3) 101 S YSCLTL="" F S YSCLTL=$O(^YSCL(603.04,1,1,"B",YSCLTL)) Q:'YSCLTL D 102 . D RR^LR7OR1(DFN,,YSCLSD,DT,,YSCLTL,"L") 103 . S YSCLSB1="" F S YSCLSB1=$O(^TMP("LRRR",$J,DFN,YSCLSB1)) Q:YSCLSB1="" D 104 . . S YSCLTDT="" F S YSCLTDT=$O(^TMP("LRRR",$J,DFN,YSCLSB1,YSCLTDT)) Q:YSCLTDT="" I $P(YSCLTDT,".",2)]"" D 105 . . . S YSCLTA="" F S YSCLTA=$O(^TMP("LRRR",$J,DFN,YSCLSB1,YSCLTDT,YSCLTA)) Q:YSCLTA="" I YSCLTA D 106 . . . . S RESULTS1=^TMP("LRRR",$J,DFN,YSCLSB1,YSCLTDT,YSCLTA) 107 . . . . S RESULTS(YSCLTL,YSCLTDT)=$P(RESULTS1,"^",2) 108 ;Find all entries for WBC and sort by inverse date. 109 S YSCLA="" F S YSCLA=$O(YSCLTLS("W",YSCLA)) Q:'YSCLA S YSCLXWBC(YSCLA)="" D 110 . S YSCLA1="" F S YSCLA1=$O(RESULTS(YSCLA,YSCLA1)) Q:'YSCLA1 S YSCLYWBC(YSCLA1)=RESULTS(YSCLA,YSCLA1)_"^"_$P($G(^LAB(60,YSCLA,0)),"^")_"^"_YSCLTLS("W",YSCLA) 111 S YSCLRWBC=$O(YSCLYWBC(0)) I 'YSCLRWBC D KILL Q "0^^^^^^"_YSCLFRQ 112 S YSCLMULT=$P(YSCLYWBC(YSCLRWBC),"^",3),YSCLMULT=$S(YSCLMULT:1000,1:1) 113 S YSCLRWBC(YSCLRWBC)=($P(YSCLYWBC(YSCLRWBC),"^")*YSCLMULT)_"^"_$P(YSCLYWBC(YSCLRWBC),"^",2) 114 ;Scan for Neutrophil count on same day and time as most recent WBC 115 S YSCLMTCH=0 F YSCLA="A","N","S","T" S YSCLTPT="" F S YSCLTPT=$O(YSCLTLS(YSCLA,YSCLTPT)) Q:'YSCLTPT D Q:YSCLMTCH 116 . S YSCLMULT=YSCLTLS(YSCLA,YSCLTPT),YSCLMULT=$S(YSCLMULT:1000,1:1) 117 . I $D(RESULTS(YSCLTPT,YSCLRWBC)),YSCLA="A" S YSCLMTCH=1,YSCLRANC(YSCLRWBC)=RESULTS(YSCLTPT,YSCLRWBC)*YSCLMULT_"^"_$P(^LAB(60,YSCLTPT,0),"^") Q 118 . I $D(RESULTS(YSCLTPT,YSCLRWBC)),YSCLA="N" S YSCLMTCH=1,YSCLRANC(YSCLRWBC)=YSCLRWBC(YSCLRWBC)*((RESULTS(YSCLTPT,YSCLRWBC))*.01)_"^"_$P(^LAB(60,YSCLTPT,0),"^") Q 119 . I $D(RESULTS(YSCLTPT,YSCLRWBC)),YSCLA="S" D 120 . . S YSCLSGS="" F S YSCLSGS=$O(YSCLTLS("B",YSCLSGS)) D Q:YSCLMTCH 121 . . . S:'YSCLSGS YSCLSGS="Z" I '$D(RESULTS(YSCLSGS,YSCLRWBC)) S RESULTS(YSCLSGS,YSCLRWBC)=0 122 . . . S YSCLMTCH=1,YSCLRANC(YSCLRWBC)=YSCLRWBC(YSCLRWBC)*((RESULTS(YSCLTPT,YSCLRWBC)*.01)+(RESULTS(YSCLSGS,YSCLRWBC)*.01))_"^"_$P(^LAB(60,YSCLTPT,0),"^")_"/"_$P($G(^LAB(60,YSCLSGS,0)),"^") Q 123 . I $D(RESULTS(YSCLTPT,YSCLRWBC)),YSCLA="C" D 124 . . S YSCLSGS="" F S YSCLSGS=$O(YSCLTLS("T",YSCLSGS)) D Q:YSCLMTCH 125 . . . S:'YSCLSGS YSCLSGS="Z" I '$D(RESULTS(YSCLSGS,YSCLRWBC)) S RESULTS(YSCLSGS,YSCLRWBC)=0 126 . . . S YSCLMTCH=1,YSCLRANC(YSCLRWBC)=((RESULTS(YSCLTPT,YSCLRWBC)*YSCLMULT)+(RESULTS(YSCLSGS,YSCLRWBC)*YSCLMULT))_"^"_$P(^LAB(60,YSCLTPT,0),"^")_"/"_$P($G(^LAB(60,YSCLSGS,0)),"^") Q 127 D KILL 128 I $G(YSCLRWBC(YSCLRWBC))<3000!($G(YSCLRANC(YSCLRWBC))<1500) Q "0^"_$G(YSCLRWBC(YSCLRWBC))_"^"_$S($G(YSCLRANC(YSCLRWBC))="":"^",1:$G(YSCLRANC(YSCLRWBC)))_"^"_(9999999-YSCLRWBC)_"^"_YSCLFRQ 129 I $G(YSCLRWBC(YSCLRWBC))<3500!($G(YSCLRANC(YSCLRWBC))<2000) Q "2^"_$G(YSCLRWBC(YSCLRWBC))_"^"_$S($G(YSCLRANC(YSCLRWBC))="":"^",1:$G(YSCLRANC(YSCLRWBC)))_"^"_(9999999-YSCLRWBC)_"^"_YSCLFRQ 130 Q "1^"_YSCLRWBC(YSCLRWBC)_"^"_YSCLRANC(YSCLRWBC)_"^"_(9999999-YSCLRWBC)_"^"_YSCLFRQ 131 ; 132 KILL ; 133 K FDA,YSCLSGS,Y15,RESULTS,RESULTS1,YSCLA,YSCLA1,YSCLMTCH,YSCLSB1,YSCLSD,YSCLTA,YSCLMULT 134 K YSCLTDT,YSCLTL,YSCLTLS,YSCLTPT,YSCLXWBC 135 ; 136 OVERRIDE(DFN) ;Check to see if the NCCC has authorized an over-ride for today on this patient. 137 S YSCLOVR=$O(^YSCL(603.01,"C",DFN,"")) 138 Q:YSCLOVR="" 0 139 S YSCLOVR=$P(^YSCL(603.01,YSCLOVR,0),"^",4) 140 Q YSCLOVR=DT 141 ; 142 ZEOR ;YSCLTST2 -
WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YTALUSE.m
r613 r623 1 YTALUSE 2 3 SCOR 4 5 6 7 8 9 10 1 YTALUSE ;ALB/ASF TEST-AUDIT ALCOHOL SCREEN ;4/30/97 09:25 2 ;;5.01;MENTAL HEALTH;**31**;Dec 30, 1994 3 SCOR ; 4 S X=^YTD(601.2,YSDFN,1,YSET,1,YSED,1) 5 S R=0 F I=1:1:8 S R=R+$E(X,I) 6 S X1=$S($E(X,9)=1:2,$E(X,9)=2:4,1:0) S R=R+X1 7 S X1=$S($E(X,10)=1:2,$E(X,10)=2:4,1:0) S R=R+X1 8 D REPT^YTREPT 9 W !!,"A score of 8 or more indicates a strong likelihood of hazardous",!,"or harmful alcohol consumption." 10 QUIT -
WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YTAPI5.m
r613 r623 1 YTAPI5 ;ALB/ASF- MH API NOTES ; 7/24/07 4:11pm 2 ;;5.01;MENTAL HEALTH;**62,85**;Dec 30, 1994;Build 49 3 Q 4 OUTNOTE(YSDATA) ; 5 N G,I,N,P,R,X,Y,YS2,YSADATE,YSCODE,YSGG,YSGG1,YSGG2,YSJ,YSJJ,YSNCODE,YSSET,YSSR,YSST,YSX1,YSX2,YSX3,YIN,YSINN,YSINE,YSMC 6 I $G(YSDATA(1))?1"[ERROR".E Q ;----> 7 I '$D(YSDATA(5)) S YSDATA(1)="[ERROR]",YSDATA(2)="bad ysdata to outnote" Q ;---> 8 S YS2=$G(YSDATA(2)) 9 S YSCODE=$P(YS2,U,2) 10 S YSADATE=$P(YS2,U,4) 11 S YSNCODE=$O(^YTT(601,"B",YSCODE,-1)) 12 S YSX1=$P(YSDATA(3),U,2) 13 S YSX2=$P(YSDATA(4),U,2) 14 S YSX3=$P(YSDATA(5),U,2) 15 S YSSR=$P(YSDATA(6),U,3) 16 S YSST=$P(YSDATA(6),U,4) 17 S Y=$G(^YTT(601.6,YSNCODE,2)) 18 I Y="" S YSDATA(1)="[ERROR]",YSDATA(2)="no mh mult outcome code" Q ;---> 19 ; 20 X Y 21 I X'>0 S YSDATA(1)="[ERROR]",YSDATA(2)="bad M executable" Q ;---> 22 LD ;LOAD NOTE 23 S N=0 24 F S N=$O(^YTT(601.6,YSNCODE,3,X,1,N)) Q:N'>0 D 25 . S YSDATA("ON",N,0)=^YTT(601.6,YSNCODE,3,X,1,N,0) 26 REP ;replace || 27 S N=0 28 F S N=$O(YSDATA("ON",N)) Q:N'>0 D 29 . S G=YSDATA("ON",N,0) 30 . S R="" 31 . F I=1:1:$L(G,"|") D 32 .. S P=$P(G,"|",I) 33 .. D:P?1"RSCORE".1N.N RSCORE 34 .. D:P?1"SSCORE".1N.N SSCORE 35 .. D:P?1"ITEM".1N.E ITEM 36 .. D:P?1"EXECUTE".E MC 37 .. S R=R_P 38 . S YSDATA("ON",N,0)=R 39 Q 40 RSCORE ; raw scores 41 S YSJ=$E(P,7,99),P=$P(YSDATA(YSJ+5),U,3) 42 Q 43 SSCORE ;scaled score 44 S YSJ=$E(P,7,99),P=$P(YSDATA(YSJ+5),U,4) 45 Q 46 ITEM ;items resolution 47 S YSIN=$E(P,5,999) 48 S YSSET=$P(YSIN,";",2) 49 S YSIN=$P(YSIN,";",1) 50 S YSINN=$S(YSIN>400:5,YSIN>200:4,1:3) 51 S YSINE=$S(YSIN#200=0:200,1:YSIN) 52 S P=$P(YSDATA(YSINN),U,2) 53 S P=$E(P,YSINE) 54 Q:YSSET="" 55 F YSJJ=1:1:$L(YSSET,",") D 56 . S YSGG=$P(YSSET,",",YSJJ),YSGG1=$P(YSGG,":"),YSGG2=$P(YSGG,":",2) 57 . S:P=YSGG1 P=YSGG2 58 Q 59 MC ;mumps executable setting P 60 S YSMC=$P(P,";",2) 61 X YSMC 62 Q 63 GAFURL(YSDATA) ;returns MH GAF horizontal sheet 64 S YSDATA(1)="[DATA]" 65 S YSDATA(2)="http://vaww.mentalhealth.med.va.gov/gafsheet.htm" 66 Q 67 PRIVL(YSDATA,YS) ;check privileges 68 N YSCODE,YSET 69 S YSCODE=$G(YS("CODE"),-1) 70 ;ASF 03/08/06 71 I (YSCODE="GAF")!(YSCODE="ASI") S YSDATA(1)="[DATA]",YSDATA(2)="1^exempt test" Q ;-->out test exempt 72 I $D(^YTT(601.71,"B",YSCODE)) D Q ;--> out 73 . S YSET=$O(^YTT(601.71,"B",YSCODE,0)) 74 . S YSDATA(1)="[DATA]" 75 . S YSKEY=$$GET1^DIQ(601.71,YSET_",",9) 76 . I YSKEY="" S YSDATA(2)="1^exempt test" Q ;-->out 77 . I $D(^XUSEC(YSKEY,DUZ)) S YSDATA(2)="1^user privileged" Q ;-->out has key 78 . S YSDATA(2)="0^no access" Q ;->out 79 ; 80 I '$D(^YTT(601,"B",YSCODE)) S YSDATA(1)="[ERROR]",YSDATA(2)="BAD TEST CODE" Q ;--> out 81 S YSET=$O(^YTT(601,"B",YSCODE,0)) 82 S YSDATA(1)="[DATA]" 83 I $D(^XUSEC("YSP",DUZ)) S YSDATA(2)="1^user privileged for all tests" Q ;has key 84 I $P(^YTT(601,YSET,0),U,10)="Y"!(YSCODE="GAF")!(YSCODE="ASI") S YSDATA(2)="1^exempt test" Q ;test exempt 85 I $P(^YTT(601,YSET,0),U,9)="I" S YSDATA(2)="1^interview" Q ;interview 86 S YSDATA(2)="0^no access" 87 Q 1 YTAPI5 ;ALB/ASF- MH API NOTES ;3/17/00 14:54 2 ;;5.01;MENTAL HEALTH;**62**;Dec 30, 1994 3 Q 4 OUTNOTE(YSDATA) ; 5 N G,I,N,P,R,X,Y,YS2,YSADATE,YSCODE,YSGG,YSGG1,YSGG2,YSJ,YSJJ,YSNCODE,YSSET,YSSR,YSST,YSX1,YSX2,YSX3,YIN,YSINN,YSINE,YSMC 6 I $G(YSDATA(1))?1"[ERROR".E Q ;----> 7 I '$D(YSDATA(5)) S YSDATA(1)="ERROR]",YSDATA(2)="bad ysdata to outnote" Q ;---> 8 S YS2=$G(YSDATA(2)) 9 S YSCODE=$P(YS2,U,2) 10 S YSADATE=$P(YS2,U,4) 11 S YSNCODE=$O(^YTT(601,"B",YSCODE,-1)) 12 S YSX1=$P(YSDATA(3),U,2) 13 S YSX2=$P(YSDATA(4),U,2) 14 S YSX3=$P(YSDATA(5),U,2) 15 S YSSR=$P(YSDATA(6),U,3) 16 S YSST=$P(YSDATA(6),U,4) 17 S Y=$G(^YTT(601.6,YSNCODE,2)) 18 I Y="" S YSDATA(1)="[ERROR"],YSDATA(2)="no mh mult outcome code" Q ;---> 19 ; 20 X Y 21 I X'>0 S YSDATA(1)="[ERROR]",YSDATA(2)="bad M executable" Q ;---> 22 LD ;LOAD NOTE 23 S N=0 24 F S N=$O(^YTT(601.6,YSNCODE,3,X,1,N)) Q:N'>0 D 25 . S YSDATA("ON",N,0)=^YTT(601.6,YSNCODE,3,X,1,N,0) 26 REP ;replace || 27 S N=0 28 F S N=$O(YSDATA("ON",N)) Q:N'>0 D 29 . S G=YSDATA("ON",N,0) 30 . S R="" 31 . F I=1:1:$L(G,"|") D 32 .. S P=$P(G,"|",I) 33 .. D:P?1"RSCORE".1N.N RSCORE 34 .. D:P?1"SSCORE".1N.N SSCORE 35 .. D:P?1"ITEM".1N.E ITEM 36 .. D:P?1"EXECUTE".E MC 37 .. S R=R_P 38 . S YSDATA("ON",N,0)=R 39 Q 40 RSCORE ; raw scores 41 S YSJ=$E(P,7,99),P=$P(YSDATA(YSJ+5),U,3) 42 Q 43 SSCORE ;scaled score 44 S YSJ=$E(P,7,99),P=$P(YSDATA(YSJ+5),U,4) 45 Q 46 ITEM ;items resolution 47 S YSIN=$E(P,5,999) 48 S YSSET=$P(YSIN,";",2) 49 S YSIN=$P(YSIN,";",1) 50 S YSINN=$S(YSIN>400:5,YSIN>200:4,1:3) 51 S YSINE=$S(YSIN#200=0:200,1:YSIN) 52 S P=$P(YSDATA(YSINN),U,2) 53 S P=$E(P,YSINE) 54 Q:YSSET="" 55 F YSJJ=1:1:$L(YSSET,",") D 56 . S YSGG=$P(YSSET,",",YSJJ),YSGG1=$P(YSGG,":"),YSGG2=$P(YSGG,":",2) 57 . S:P=YSGG1 P=YSGG2 58 Q 59 MC ;mumps executable setting P 60 S YSMC=$P(P,";",2) 61 X YSMC 62 Q 63 GAFURL(YSDATA) ;returns MH GAF horizontal sheet 64 S YSDATA(1)="[DATA]" 65 S YSDATA(2)="http://vaww.mentalhealth.med.va.gov/gafsheet.htm" 66 Q 67 PRIVL(YSDATA,YS) ;check privileges 68 N YSCODE,YSET 69 S YSCODE=$G(YS("CODE"),-1) 70 I '$D(^YTT(601,"B",YSCODE)) S YSDATA(1)="[ERROR]",YSDATA(2)="BAD TEST CODE" Q ;--> out 71 S YSET=$O(^YTT(601,"B",YSCODE,0)) 72 S YSDATA(1)="[DATA]" 73 I $D(^XUSEC("YSP",DUZ)) S YSDATA(2)="1^user privileged for all tests" Q ;has key 74 I $P(^YTT(601,YSET,0),U,10)="Y"!(YSCODE="GAF")!(YSCODE="ASI") S YSDATA(2)="1^exempt test" Q ;test exempt 75 I $P(^YTT(601,YSET,0),U,9)="I" S YSDATA(2)="1^interview" Q ;interview 76 S YSDATA(2)="0^no access" 77 Q -
WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YTAUIRR.m
r613 r623 1 YTAUIRR ;ALB/ASF- AUI-R REPORT ;11/15/90 16:58 ; 4/6/07 4:12pm 2 ;;5.01;MENTAL HEALTH;**37,85**;Dec 30, 1994;Build 49 3 F0 ; 4 S R="",J=1 5 T0 ; 6 S L=200,M=0,YSKK=1,YSTL=0 G:'$D(^YTT(601,YSTEST,"S",J,"K",YSKK,0)) STND D RD 7 T1 ; 8 I '$D(^YTT(601,YSTEST,"S",J,"K",YSKK,0)) S R=R_YSTL_"^",J=J+1 G T0 9 S Y=^YTT(601,YSTEST,"S",J,"K",YSKK,0),P=1 10 T2 ; 11 S YSIT=$P(Y,U,P) I YSIT="" S YSKK=YSKK+1 G T1 12 S A=$P(Y,U,P+1),A=$A(A)-64,P=P+2 13 T3 ; 14 I +YSIT>L S L=L+200,M=M+200 D RD G T3 15 S:$E(X,+YSIT-M)=A YSTL=YSTL+$P(YSIT,"(",2) G T2 16 RD ; 17 S X=^YTD(601.2,YSDFN,1,YSET,1,YSED,L\200) Q 18 STND ; 19 S J=1,S="" 20 LK ; 21 S A=$P(R,U,J) G:A="" REPT S L1=$P(^YTT(601,YSTEST,"S",J,"M"),U) I A<L1 S S=S_"0^",J=J+1 G LK 22 I $D(^YTT(601,YSTEST,"S",J,"MS")) S L2=+^YTT(601,YSTEST,"S",J,"MS") I A'<L2 S S=S_$P(^YTT(601,YSTEST,"S",J,"MS"),U,A+2-L2),J=J+1 G LK 23 S S=S_$P(^YTT(601,7,"S",J,"M"),U,A+2-L1)_"^",J=J+1 G LK 24 REPT ; 25 Q:YSTY["X" ;--> out ASF 09/15/04 26 S X1="",$P(X1,"# ",60)="" 27 S X=$P(^YTT(601,YSTEST,"P"),U),A=$P(^("P"),U,2),B=$P(^("P"),U,3),L1=58-A\2,L2=L1+A+4 S:A<9 A=9 28 D DTA W !!?(72-$L(X)\2),X,!!!?4,"S C A L E",?22,"RAW DECILE RANK" 29 F J=1:1 S YSRS=$P(R,U,J) Q:YSRS="" D:IOST?1"C-".E&($Y>21) SCR D H1:J=1,H5:J=5,H8:J=8,H13:J=13,H18:J=18,H24:J=24 W !?4,$P(^YTT(601,YSTEST,"S",J,0),U,2),?20,$J(YSRS,4,0),$J($P(S,U,J),5)," |",$E(X1,1,2*$P(S,U,J)) 30 Q 31 IR ; 32 S P0=$S(IOST?1"P".E:1,1:0),K=0,YSLFT=0 F I=1:1 Q:'$D(^YTD(601.2,YSDFN,1,YSET,1,YSED,I)) S K=K+$L(^(I)) 33 S K=K\10+$Y D DTA S X=$P(^YTT(601,YSTEST,"P"),U) W !!?(72-$L(X)/2),X 34 W !!!?25,"--- ITEM RESPONSES ---",!! S L=200,M=0,YSIT=1 I $D(^YTD(601.2,YSDFN,1,YSTEST,1,YSHD,99)),^(99)="MMPIR" S L=800 35 R2 ; 36 D RD S A=$L(X),B=A\10 I B S K=10 F I=1:1:B D RLN Q:YSLFT 37 G:YSLFT DONE 38 S K=-10*B+A I K D RLN G DONE 39 G:A<200 DONE S L=L+200,M=M+200 I $D(^YTD(601.2,YSDFN,1,YSET,1,YSED,L\200)) G R2 40 DONE ; 41 K YSTY,X,Y,A,B,K,YSKK,L,L1,L2,M,J,YSIT,YSRS,I,P,YSMX,YSTL,YSTTL Q 42 RLN ; 43 W ?1 F YSKK=1:1:K W $J(YSIT,3,0)," ",$E(X,YSIT-M)," " S YSIT=YSIT+1 44 D:'P0&($Y>21) SCR:I<B W ! Q 45 SCR ; 46 ; Added 5/6/94 LJA 47 N A,B,B1,C,D,E,E1,F,F1,G,G1,H,I,J,J1,J2,J3,J4,K,L,L1,L2,M,N 48 N N1,N2,N3,N4,P,P0,P1,P3,R,R1,S,S1,T,T1,T2,TT,V,V1,V2,V3 49 N V4,V5,V6,W,X,X0,X1,X2,X3,X4,X7,X8,X9,Y,Y1,Y2,Z,Z1,Z3 50 ; 51 F I0=1:1:(IOSL-$Y-2) W ! 52 N DTOUT,DUOUT,DIRUT 53 S DIR(0)="E" D ^DIR K DIR S YSTOUT=$D(DTOUT),YSUOUT=$D(DUOUT),YSLFT=$D(DIRUT) 54 W @IOF Q 55 DTA ; 56 D KVAR^VADPT S DFN=YSDFN 57 D DEM^VADPT,PID^VADPT 58 S YSNM=VADM(1),YSSEX=$P(VADM(5),U),YSDOB=$P(VADM(3),U,2),YSAGE=VADM(4),YSSSN=VA("PID"),YSBID=VA("BID") 59 D KVAR^VADPT 60 S X0=^YTD(601.2,YSDFN,1,YSET,1,YSED,0),YSDTA=$P(X0,U,5) S:YSDTA'="" YSDTA=$$FMTE^XLFDT(YSDTA,"5ZD") 61 S YSSX=YSSEX,YSBL=" ",YSHDR=YSSSN_" "_YSNM_YSBL_YSBL_YSBL,YSHD=DT 62 S YSHDR=$E(YSHDR,1,43)_" "_YSSEX_" AGE "_$J(YSAGE,2,0)_" "_YSDT(0)_" "_$$FMTE^XLFDT(YSHD,"5ZD") W @IOF,YSHDR," ",YSDTA 63 S X=$P(^YTT(601,YSTEST,"P"),U) 64 W ! S X7=$P(X0,U),X8=$P(X0,U,8) I X8,X8<X7 W "Begun: ",$$FMTE^XLFDT(X8,"5ZD")," Finished ",$$FMTE^XLFDT(X7,"5ZD") 65 W ?53,"PRINTED ENTERED " W:YSDTA'="" "ADMIN" Q 66 H1 ; 67 W !,"PRIMARY SCALES",!?2,"Benefits" Q 68 H5 ; 69 W !!?2,"Styles" Q 70 H8 ; 71 W !!?2,"Consequences" Q 72 H13 ; 73 W !!?2,"Concerns and Acknowledgements" Q 74 H18 ; 75 W !!,"SECOND ORDER FACTOR SCALES" Q 76 H24 ; 77 W !!,"GENERAL ALCOHOL INVOLVEMENT SCALE" Q 1 YTAUIRR ;ALB/ASF- AUI-R REPORT ;11/15/90 16:58 ; 2 ;;5.01;MENTAL HEALTH;**37**;Dec 30, 1994 3 F0 ; 4 S R="",J=1 5 T0 ; 6 S L=200,M=0,YSKK=1,YSTL=0 G:'$D(^YTT(601,YSTEST,"S",J,"K",YSKK,0)) STND D RD 7 T1 ; 8 I '$D(^YTT(601,YSTEST,"S",J,"K",YSKK,0)) S R=R_YSTL_"^",J=J+1 G T0 9 S Y=^YTT(601,YSTEST,"S",J,"K",YSKK,0),P=1 10 T2 ; 11 S YSIT=$P(Y,U,P) I YSIT="" S YSKK=YSKK+1 G T1 12 S A=$P(Y,U,P+1),A=$A(A)-64,P=P+2 13 T3 ; 14 I +YSIT>L S L=L+200,M=M+200 D RD G T3 15 S:$E(X,+YSIT-M)=A YSTL=YSTL+$P(YSIT,"(",2) G T2 16 RD ; 17 S X=^YTD(601.2,YSDFN,1,YSET,1,YSED,L\200) Q 18 STND ; 19 S J=1,S="" 20 LK ; 21 S A=$P(R,U,J) G:A="" REPT S L1=$P(^YTT(601,YSTEST,"S",J,"M"),U) I A<L1 S S=S_"0^",J=J+1 G LK 22 I $D(^YTT(601,YSTEST,"S",J,"MS")) S L2=+^YTT(601,YSTEST,"S",J,"MS") I A'<L2 S S=S_$P(^YTT(601,YSTEST,"S",J,"MS"),U,A+2-L2),J=J+1 G LK 23 S S=S_$P(^YTT(601,7,"S",J,"M"),U,A+2-L1)_"^",J=J+1 G LK 24 REPT ; 25 S X1="",$P(X1,"# ",60)="" 26 S X=$P(^YTT(601,YSTEST,"P"),U),A=$P(^("P"),U,2),B=$P(^("P"),U,3),L1=58-A\2,L2=L1+A+4 S:A<9 A=9 27 D DTA W !!?(72-$L(X)\2),X,!!!?4,"S C A L E",?22,"RAW DECILE RANK" 28 F J=1:1 S YSRS=$P(R,U,J) Q:YSRS="" D:IOST?1"C-".E&($Y>21) SCR D H1:J=1,H5:J=5,H8:J=8,H13:J=13,H18:J=18,H24:J=24 W !?4,$P(^YTT(601,YSTEST,"S",J,0),U,2),?20,$J(YSRS,4,0),$J($P(S,U,J),5)," |",$E(X1,1,2*$P(S,U,J)) 29 Q 30 IR ; 31 S P0=$S(IOST?1"P".E:1,1:0),K=0,YSLFT=0 F I=1:1 Q:'$D(^YTD(601.2,YSDFN,1,YSET,1,YSED,I)) S K=K+$L(^(I)) 32 S K=K\10+$Y D DTA S X=$P(^YTT(601,YSTEST,"P"),U) W !!?(72-$L(X)/2),X 33 W !!!?25,"--- ITEM RESPONSES ---",!! S L=200,M=0,YSIT=1 I $D(^YTD(601.2,YSDFN,1,YSTEST,1,YSHD,99)),^(99)="MMPIR" S L=800 34 R2 ; 35 D RD S A=$L(X),B=A\10 I B S K=10 F I=1:1:B D RLN Q:YSLFT 36 G:YSLFT DONE 37 S K=-10*B+A I K D RLN G DONE 38 G:A<200 DONE S L=L+200,M=M+200 I $D(^YTD(601.2,YSDFN,1,YSET,1,YSED,L\200)) G R2 39 DONE ; 40 K YSTY,X,Y,A,B,K,YSKK,L,L1,L2,M,J,YSIT,YSRS,I,P,YSMX,YSTL,YSTTL Q 41 RLN ; 42 W ?1 F YSKK=1:1:K W $J(YSIT,3,0)," ",$E(X,YSIT-M)," " S YSIT=YSIT+1 43 D:'P0&($Y>21) SCR:I<B W ! Q 44 SCR ; 45 ; Added 5/6/94 LJA 46 N A,B,B1,C,D,E,E1,F,F1,G,G1,H,I,J,J1,J2,J3,J4,K,L,L1,L2,M,N 47 N N1,N2,N3,N4,P,P0,P1,P3,R,R1,S,S1,T,T1,T2,TT,V,V1,V2,V3 48 N V4,V5,V6,W,X,X0,X1,X2,X3,X4,X7,X8,X9,Y,Y1,Y2,Z,Z1,Z3 49 ; 50 F I0=1:1:(IOSL-$Y-2) W ! 51 N DTOUT,DUOUT,DIRUT 52 S DIR(0)="E" D ^DIR K DIR S YSTOUT=$D(DTOUT),YSUOUT=$D(DUOUT),YSLFT=$D(DIRUT) 53 W @IOF Q 54 DTA ; 55 S X0=^YTD(601.2,YSDFN,1,YSET,1,YSED,0),YSDTA=$P(X0,U,5) S:YSDTA'="" YSDTA=$$FMTE^XLFDT(YSDTA,"5ZD") 56 S YSHDR=$E(YSHDR,1,43)_" "_YSSEX_" AGE "_$J(YSAGE,2,0)_" "_YSDT(0)_" "_$$FMTE^XLFDT(YSHD,"5ZD") W @IOF,YSHDR," ",YSDTA 57 W ! S X7=$P(X0,U),X8=$P(X0,U,8) I X8,X8<X7 W "Begun: ",$$FMTE^XLFDT(X8,"5ZD")," Finished ",$$FMTE^XLFDT(X7,"5ZD") 58 W ?53,"PRINTED ENTERED " W:YSDTA'="" "ADMIN" Q 59 H1 ; 60 W !,"PRIMARY SCALES",!?2,"Benefits" Q 61 H5 ; 62 W !!?2,"Styles" Q 63 H8 ; 64 W !!?2,"Consequences" Q 65 H13 ; 66 W !!?2,"Concerns and Acknowledgements" Q 67 H18 ; 68 W !!,"SECOND ORDER FACTOR SCALES" Q 69 H24 ; 70 W !!,"GENERAL ALCOHOL INVOLVEMENT SCALE" Q -
WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YTDOMR.m
r613 r623 1 YTDOMR ;ALB/ASF-DEPRESSION OUTCOME MODULE REPORT ; 5/7/07 10:39am 2 ;;5.01;MENTAL HEALTH;**31,85**;Dec 30, 1994;Build 49 3 EN81 ; 4 D ^YTDOMR1 5 S (YSCR,YSDEP,YSPA,YSPB,YSSEV,YSNOT)=0 6 S R=^YTD(601.2,YSDFN,1,YSTEST,1,YSED,1) 7 ;PART A SAD-NOFUN 8 I $E(R,49)>2!($E(R,50)>2) S YSPA=1 9 ;PART B DEPRESSIVE SYMPTOMS 4 WEEKS 10 I $E(R,49)>2 S YSCR=YSCR+1 11 I $E(R,50)>2 S YSCR=YSCR+1 12 I $E(R,51)>2!($E(R,52)>2) S YSCR=YSCR+1 13 I $E(R,53)>2 S YSCR=YSCR+1 14 I $E(R,54)>2 S YSCR=YSCR+1 15 I $E(R,55)>2 S YSCR=YSCR+1 16 I $E(R,56)>2 S YSCR=YSCR+1 17 I $E(R,57)>2 S YSCR=YSCR+1 18 I $E(R,58)>2!($E(R,59)="Y") S YSCR=YSCR+1 19 I YSCR>4 S YSPB=1 20 ;MISSING 21 S YSMISS=$L($E(R,49,59),"X")-1 22 I ((YSCR<5)&((YSMISS+YSCR)>4))!(YSMISS>4) S YSPB="" 23 I YSPA,YSPB S YSDEP=1 24 I YSPB="" S YSDEP="" 25 I $E(R,25)="Y" S YSNOT=1 26 F I=49:1:59 S X=$E(R,I) S X=$S(X="Y":3,X="N":0,X?1N:X-1,1:0) S YSSEV=YSSEV+X 27 S YSSEV=YSSEV/(11-YSMISS)*33.33 28 I YSMISS>1 S YSSEV="" 29 OUT81 ; 30 S I1="",$P(I1,"_",79)="" W !!,I1 31 W !,"Scoring: By self report," 32 W:YSDEP'="" !,"The patient "_$S(YSDEP:"DOES",1:"DOES NOT")_" meet DSM IV Criterion A for Major Depressive Episode." 33 W:YSDEP="" !,"Diagnosis not available due to "_YTMISS_" missing items" 34 I YSNOT W !,"However a recent death is reported." 35 W !?15,"DOM severity score= " 36 W $S(YSSEV="":" not scoreable due to missing items",1:$J(YSSEV,3,0)) 37 W !,"There are no normative data for interpreting the severity score, but changes" 38 W !,"between this score and the score on the DOM Patient Follow-Up Assessment",!,"(Form 8.3) may reflect changes in the severity of the patient's symptoms." 39 W !,I1 40 Q 41 EN82 ; 42 D ^YTDOMR1 43 S (YSCR,YSDEP,YSPA,YSPB,YSSEV,YSNOT)=0 44 S R=^YTD(601.2,YSDFN,1,YSTEST,1,YSED,1) 45 I $E(R,4)="Y"!($E(R,5)="Y") S YSPA=1 46 F I=4:1:12 S:$E(R,I)="Y" YSCR=YSCR+1 47 S:YSCR>4 YSPB=1 48 I YSPA&YSPB S YSDEP=1 49 F I=13,14,15,18,20,21,22 S:$E(R,I)="Y" YSNOT=1 50 ; 51 OUT82 ; 52 S I1="",$P(I1,"_",79)="" W !!,I1 53 W !,"Scoring:" 54 S X=$E(R,1) 55 W !,"Clinician reports: " 56 W $S(X=1:"MAJOR DEPRESSION (SINGLE EPISODE OR RECURRENT)",X=2:"Mood Disorder secondary to a general medical condition",X=3:"Posttraumatic Stress Disorder",X=4:"Substance use disorder(s)",X=5:"NO MAJOR DEPRESSION",1:"??") 57 W !,"The patient "_$S(YSDEP:"DOES",1:"DOES NOT")_" meet DSM IV criteria for major depression." 58 I YSNOT W !,"However exclusionary features are reported." 59 W !,I1 60 Q 61 EN80 ; 62 D ^YTDOMR1 63 S X=^YTD(601.2,YSDFN,1,YSET,1,YSED,1) 64 S X1=0 65 S:$E(X,1)="Y" X1=1 66 S:($E(X,2)="Y")&($E(X,3)="Y")&($E(X,4)>1) X1=1 67 W:(X1=1) !!,"This screen is positive, and the possibility of a mood disorder",!,"should be evaluated further." 68 W:(X1=0) !!,"This screen for mood disorder is negative." 69 Q 70 ENG ;geriatric screen 71 S YSHDR=$E(YSHDR,1,43)_" "_YSSEX_" AGE "_$J(YSAGE,2,0) 72 W @IOF,YSHDR,?53,$$FMTE^XLFDT(DT,"5ZD"),?64,$$FMTE^XLFDT(YSHD,"5ZD") 73 W !,?53,"PRINTED",?64,"ENTERED",! 74 W !!,?3,"*** Geriatric Depression Screen ***",!! 75 W !,"The patient was questioned about mood in the past week.",! 76 W !,"Felt could not shake off blues: " S YSI=1 D ENGQ 77 W !,"Felt depressed: " S YSI=2 D ENGQ 78 W !,"Felt fearful: " S YSI=3 D ENGQ 79 W !,"Sleep was restless: " S YSI=4 D ENGQ 80 W !,"Felt hopeless about the future: " S YSI=5 D ENGQ 81 S X=^YTD(601.2,YSDFN,1,YSET,1,YSED,1) 82 S (YSMISS,YSDEP)=0 F I=1:1:4 S YSDEP=YSDEP+$E(X,I) S:$E(X,I)="X" YSMISS=YSMISS+1 ; ASF 10/20/06 83 S:$E(X,5)?1N YSDEP=YSDEP+(3-$E(X,5)) S:$E(X,5)="X" YSMISS=YSMISS+1 84 I YSMISS=1 S YSDEP=YSDEP+(YSDEP/4) 85 I YSMISS>1 W !!,"The validity of this test is compromised as "_YSMISS_" of the 5 questions",!,"were not answered." Q 86 W !!,"Score: "_YSDEP 87 W:(YSDEP>3.9) !,"This screen is positive, and the possibility of a mood disorder",!,"should be evaluated further." 88 W:(YSDEP<4) !,"This screen for mood disorder is negative." 89 Q 90 ENGQ ; 91 S Y1=$E(^YTD(601.2,YSDFN,1,YSET,1,YSED,1),YSI) 92 I YSI<5 W $S(Y1=0:"rarely",Y1=1:"some of the time",Y1=2:"much of the time",Y1=3:"most of the time",1:"question not answered") 93 I YSI=5 W $S(Y1=3:"rarely",Y1=2:"some of the time",Y1=1:"much of the time",Y1=0:"most of the time",1:"question not answered") 1 YTDOMR ;ALB/ASF-DEPRESSION OUTCOME MODULE REPORT ;2/23/99 15:09 2 ;;5.01;MENTAL HEALTH;**31**;Dec 30, 1994 3 EN81 ; 4 D ^YTDOMR1 5 S (YSCR,YSDEP,YSPA,YSPB,YSSEV,YSNOT)=0 6 S R=^YTD(601.2,YSDFN,1,YSTEST,1,YSED,1) 7 ;PART A SAD-NOFUN 8 I $E(R,49)>2!($E(R,50)>2) S YSPA=1 9 ;PART B DEPRESSIVE SYMPTOMS 4 WEEKS 10 I $E(R,49)>2 S YSCR=YSCR+1 11 I $E(R,50)>2 S YSCR=YSCR+1 12 I $E(R,51)>2!($E(R,52)>2) S YSCR=YSCR+1 13 I $E(R,53)>2 S YSCR=YSCR+1 14 I $E(R,54)>2 S YSCR=YSCR+1 15 I $E(R,55)>2 S YSCR=YSCR+1 16 I $E(R,56)>2 S YSCR=YSCR+1 17 I $E(R,57)>2 S YSCR=YSCR+1 18 I $E(R,58)>2!($E(R,59)="Y") S YSCR=YSCR+1 19 I YSCR>4 S YSPB=1 20 ;MISSING 21 S YSMISS=$L($E(R,49,59),"X")-1 22 I ((YSCR<5)&((YSMISS+YSCR)>4))!(YSMISS>4) S YSPB="" 23 I YSPA,YSPB S YSDEP=1 24 I YSPB="" S YSDEP="" 25 I $E(R,25)="Y" S YSNOT=1 26 F I=49:1:59 S X=$E(R,I) S X=$S(X="Y":3,X="N":0,X?1N:X-1,1:0) S YSSEV=YSSEV+X 27 S YSSEV=YSSEV/(11-YSMISS)*33.33 28 I YSMISS>1 S YSSEV="" 29 OUT81 ; 30 S I1="",$P(I1,"_",79)="" W !!,I1 31 W !,"Scoring: By self report," 32 W:YSDEP'="" !,"The patient "_$S(YSDEP:"DOES",1:"DOES NOT")_" meet DSM IV Criterion A for Major Depressive Episode." 33 W:YSDEP="" !,"Diagnosis not available due to "_YTMISS_" missing items" 34 I YSNOT W !,"However a recent death is reported." 35 W !?15,"DOM severity score= " 36 W $S(YSSEV="":" not scoreable due to missing items",1:$J(YSSEV,3,0)) 37 W !,"There are no normative data for interpreting the severity score, but changes" 38 W !,"between this score and the score on the DOM Patient Follow-Up Assessment",!,"(Form 8.3) may reflect changes in the severity of the patient's symptoms." 39 W !,I1 40 Q 41 EN82 ; 42 D ^YTDOMR1 43 S (YSCR,YSDEP,YSPA,YSPB,YSSEV,YSNOT)=0 44 S R=^YTD(601.2,YSDFN,1,YSTEST,1,YSED,1) 45 I $E(R,4)="Y"!($E(R,5)="Y") S YSPA=1 46 F I=4:1:12 S:$E(R,I)="Y" YSCR=YSCR+1 47 S:YSCR>4 YSPB=1 48 I YSPA&YSPB S YSDEP=1 49 F I=13,14,15,18,20,21,22 S:$E(R,I)="Y" YSNOT=1 50 ; 51 OUT82 ; 52 S I1="",$P(I1,"_",79)="" W !!,I1 53 W !,"Scoring:" 54 S X=$E(R,1) 55 W !,"Clinician reports: " 56 W $S(X=1:"MAJOR DEPRESSION (SINGLE EPISODE OR RECURRENT)",X=2:"Mood Disorder secondary to a general medical condition",X=3:"Posttraumatic Stress Disorder",X=4:"Substance use disorder(s)",X=5:"NO MAJOR DEPRESSION",1:"??") 57 W !,"The patient "_$S(YSDEP:"DOES",1:"DOES NOT")_" meet DSM IV criteria for major depression." 58 I YSNOT W !,"However exclusionary features are reported." 59 W !,I1 60 Q 61 EN80 ; 62 D ^YTDOMR1 63 S X=^YTD(601.2,YSDFN,1,YSET,1,YSED,1) 64 S X1=0 65 S:$E(X,1)="Y" X1=1 66 S:($E(X,2)="Y")&($E(X,3)="Y")&($E(X,4)>1) X1=1 67 W:(X1=1) !!,"This screen is positive, and the possibility of a mood disorder",!,"should be evaluated further." 68 W:(X1=0) !!,"This screen for mood disorder is negative." 69 Q 70 ENG ;geriatric screen 71 S YSHDR=$E(YSHDR,1,43)_" "_YSSEX_" AGE "_$J(YSAGE,2,0) 72 W @IOF,YSHDR,?53,$$FMTE^XLFDT(DT,"5ZD"),?64,$$FMTE^XLFDT(YSHD,"5ZD") 73 W !,?53,"PRINTED",?64,"ENTERED",! 74 W !!,?3,"*** Geriatric Depression Screen ***",!! 75 W !,"The patient was questioned about mood in the past week.",! 76 W !,"Felt could not shake off blues: " S YSI=1 D ENGQ 77 W !,"Felt depressed: " S YSI=2 D ENGQ 78 W !,"Felt fearful: " S YSI=3 D ENGQ 79 W !,"Sleep was restless: " S YSI=4 D ENGQ 80 W !,"Felt hopeful about the future: " S YSI=5 D ENGQ 81 S X=^YTD(601.2,YSDFN,1,YSET,1,YSED,1) 82 S (YSMISS,YSDEP)=0 F I=1:1:5 S YSDEP=YSDEP+$E(X,I) S:$E(X,I)="X" YSMISS=YSMISS+1 83 I YSMISS=1 S YSDEP=YSDEP+(YSDEP/4) 84 I YSMISS>1 W !!,"The validity of this test is compromised as "_YSMISS_" of the 5 questions",!,"were not answered." Q 85 W !!,"Score: "_YSDEP 86 W:(YSDEP>3.9) !,"This screen is positive, and the possibility of a mood disorder",!,"should be evaluated further." 87 W:(YSDEP<4) !,"This screen for mood disorder is negative." 88 Q 89 ENGQ ; 90 S Y1=$E(^YTD(601.2,YSDFN,1,YSET,1,YSED,1),YSI) 91 I YSI<5 W $S(Y1=0:"rarely",Y1=1:"some of the time",Y1=2:"much of the time",Y1=3:"most of the time",1:"question not answered") 92 I YSI=5 W $S(Y1=3:"rarely",Y1=2:"some of the time",Y1=1:"much of the time",Y1=0:"most of the time",1:"question not answered") -
WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YTDOMR1.m
r613 r623 1 YTDOMR1 2 3 4 MAIN 5 6 7 8 9 10 R1 11 12 13 R2 14 15 16 17 18 19 20 21 22 STEM 23 24 25 26 27 28 END 29 30 LISTER 31 32 33 34 35 36 37 38 39 40 41 42 43 44 LIST1 45 46 47 48 49 50 51 L 52 53 54 55 56 57 58 59 PRT 60 61 62 63 64 65 66 67 68 69 WAIT 70 71 72 73 74 75 76 77 PRO 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 1 YTDOMR1 ;ALB/ASF SLC/DKG-EXTENDED INTERVIEW REPORTER ;6/19/97 17:09 2 ;;5.01;MENTAL HEALTH;**31**;Dec 30, 1994 3 ; 4 MAIN ; 5 K ^UTILITY($J,"W") 6 S YSLFN=1 ; S YSJ=1,U1=0,L=-200,YSLCK=200 7 D R1 8 D PRT 9 Q 10 R1 ; 11 F YSJ=1:1 Q:'$D(^YTT(601,YSTEST,"G",1,1,YSJ,0)) D R2 12 Q 13 R2 ; 14 S A=^YTT(601,YSTEST,"G",1,1,YSJ,0),YSITEM=+$P(A,U),YSEXE=$P($P(A,U),";",2) 15 I YSITEM=0 S R="" X YSEXE D STEM Q 16 I YSEXE="L"!(YSEXE="'L") D LISTER Q 17 S L=(YSITEM-1)\200*200,U1=L+200,YSYX=^YTD(601.2,YSDFN,1,YSET,1,YSED,U1\200) 18 S R=$E(YSYX,YSITEM-L) Q:R=" "!(R="X") 19 S:"YN"[R R=R="N"+1 S R=$P(A,U,R+2) Q:R="" 20 D STEM 21 Q 22 STEM ; 23 S YSSTEM=$P(A,U,2) 24 I YSSTEM'["#" S YSYTX=YSSTEM_R D L Q 25 S A=$F(YSSTEM,"#") I A<3 S YSYTX=R_$E(YSSTEM,2,999) D L Q 26 S YSYTX=$E(YSSTEM,1,A-2)_R_$E(YSSTEM,A,999) D L 27 Q 28 END ; 29 K I,YSLCK,R,YSSTEM,YSYX,YSYCK,YSSCK Q 30 LISTER ;list formated output 31 K B1 S YSTL=0,YSTLN=1,YSCOMP=$S(YSEXE="'L":"N",1:"Y") 32 ; check at list begining 33 S YSQTYP=^YTT(601,YSTEST,"Q",YSITEM,1) I YSQTYP'=1 S R="eRROR LINE "_YSJ D STEM Q 34 S L=(YSITEM-1)\200*200,U1=L+200,YSYX=^YTD(601.2,YSDFN,1,YSET,1,YSED,U1\200) 35 S R=$E(YSYX,YSITEM-L) 36 S:R=YSCOMP YSTL=YSTL+1,B1(YSTL)=$P(A,U,3) 37 D LIST1 38 I 'YSTL S R=$P(A,U,YSTLN+2) D STEM Q 39 I YSTL=1 S R=B1(1) D STEM Q 40 I YSTL=2 S R=B1(1)_" and "_B1(2) D STEM Q 41 S R="" F I=1:1:YSTL-1 S R=R_B1(I)_", " 42 S R=R_"and "_B1(YSTL) D STEM 43 Q 44 LIST1 S YSTLN=YSTLN+1,YSITEM=YSITEM+1 45 Q:'$D(^YTT(601,YSTEST,"Q",YSITEM)) 46 S YSQTYP=^YTT(601,YSTEST,"Q",YSITEM,1) Q:YSQTYP'=2 47 S L=(YSITEM-1)\200*200,U1=L+200,YSYX=^YTD(601.2,YSDFN,1,YSET,1,YSED,U1\200) 48 S R=$E(YSYX,YSITEM-L) 49 S:R=YSCOMP YSTL=YSTL+1,B1(YSTL)=$P(A,U,YSTLN+2) 50 G LIST1 51 L ; 52 D:YSYTX["{" PRO ;evaluate pronouns etc 53 I $L(YSYTX)<80 S DIWL=0,DIWR=79,X=YSYTX D ^DIWP 54 I $L(YSYTX)>80 D 55 . S YSX1=YSYTX 56 . F I=$L(YSX1):-1:1 S Y1=$E(YSX1,I) I Y1=" "&(I<80) S X=$E(YSX1,1,I-1),YSX1=$E(YSX1,I+1,999),DIWL=0,DIWR=79 D ^DIWP Q 57 . I $L(YSX1),YSX1'=" " S DIWL=0,DIWR=79,X=YSX1 D ^DIWP 58 Q 59 PRT ; Print output 60 S YSZZ=0 61 S YSHDR=$E(YSHDR,1,43)_" "_YSSEX_" AGE "_$J(YSAGE,2,0) 62 W @IOF,YSHDR,?53,$$FMTE^XLFDT(DT,"5ZD"),?64,$$FMTE^XLFDT(YSHD,"5ZD") 63 W !,?53,"PRINTED",?64,"ENTERED",! 64 S N=0 F S N=$O(^UTILITY($J,"W",0,N)) Q:N'>0!YSZZ D 65 . W !,^UTILITY($J,"W",0,N,0) 66 . D:$Y+4>IOSL WAIT 67 ; 68 Q 69 WAIT ; 70 F I0=1:1:IOSL-$Y-2 W ! 71 N DTOUT,DUOUT,DIRUT 72 I IOST?1"C".E W $C(7) S DIR(0)="E" D ^DIR K DIR S YSZZ=$D(DIRUT) 73 Q:YSZZ 74 W @IOF,YSHDR,?53,$$FMTE^XLFDT(DT,"5ZD"),?64,$$FMTE^XLFDT(YSHD,"5ZD") 75 W !?53,"PRINTED",?64,"ENTERED",! 76 Q 77 PRO ;evaluate pronoun, possesive etc 78 F I=1:1:$L(YSYTX,"{") D 79 . S P1=$F(YSYTX,"{")-1,P2=$F(YSYTX,"}") 80 . Q:'P1!'P2 81 . S G=$E(YSYTX,P1+1,P2-2),G1=0 82 . S:G="Pro" G1=$S(YSSEX="F":"She",1:"He") 83 . S:G="pro" G1=$S(YSSEX="F":"she",1:"he") 84 . S:G="Pos" G1=$S(YSSEX="F":"Her",1:"His") 85 . S:G="pos" G1=$S(YSSEX="F":"her",1:"his") 86 . S:G="Title" G1=$S(YSSEX="F":"Ms.",1:"Mr.") 87 . S:G="DATE" G1=$E(YSED,4,5)_"/"_$E(YSED,6,7)_"/"_$E(YSED,2,3) 88 . S:G="CLIN" G1=$P($G(^VA(200,$P(^YTD(601.2,YSDFN,1,YSET,1,YSED,0),U,3),20)),U,2) 89 . I G="Last" S X=$P($P(^DPT(YSDFN,0),U),",") D 90 .. F %=2:1:$L(X) I $E(X,%)?1U,$E(X,%-1)?1A S X=$E(X,0,%-1)_$C($A(X,%)+32)_$E(X,%+1,999) 91 .. S G1=X 92 . S YSYTX=$E(YSYTX,1,P1-1)_G1_$E(YSYTX,P2,999) 93 ; 94 Q -
WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YTKIL.m
r613 r623 1 YTKIL ;SLC/TGA-KILL TEST/INTERVIEW DATA ;4/21/92 08:50 ; 10/31/07 12:41pm 2 ;;5.01;MENTAL HEALTH;**37,85**;Dec 30, 1994;Build 49 3 ; 4 ; Called from the top by MENU option YSMKIL 5 ; 6 S YSO=0,YSNOKILL=1 W @IOF,!!,"Delete Patient Data" 7 W ! D ^YSLRP G:YSDFN<1 END 8 S DIR(0)="Y",DIR("A")="Delete MHA3 data",DIR("B")="No" D ^DIR 9 Q:$G(DIRUT) 10 IF Y D EN^YTQKIL Q ;-->out 11 I '$D(^YTD(601.2,YSDFN)),'$D(^YTD(601.4,YSDFN)) W !!,"NO DATA ON THIS PATIENT!" G END 12 R ; 13 R !!,"Delete All tests and interviews? N// ",A:DTIME S YSTOUT='$T,YSUOUT=A["^" G:YSTOUT!YSUOUT END S A=$TR($E(A_"N"),"yn","YN") I "YN"'[A W:A'["?" " ?",$C(7) G R 14 I "Y"[A S DIK="^YTD(601.2,",DA=YSDFN D ^DIK S DIK="^YTD(601.4,",DA=YSDFN D ^DIK W !!,"DELETED!" G END 15 S T(0)=0 G:'$O(^YTD(601.4,YSDFN,1,0)) C W !!,"Incomplete tests and Interviews",! S YTC=$O(^YTT(601,"B","CLERK",0)) 16 S T=0 17 F S T=$O(^YTD(601.4,YSDFN,1,T)) G:'T C S T(0)=T(0)+1 G:YSTOUT!YSUOUT END S X=^(T,0),P=$P(X,U),D=$P(X,U,2),DA=P S:P=YTC P=$P(X,U,6),DA=YTC W !!,$$TN(+YSDFN,+T,+P),?10,$$FMTE^XLFDT(D,"5ZD") D DI 18 DI ; 19 R " ...Delete? N// ",K:DTIME S YSTOUT='$T,YSUOUT=K["^",K=$E(K) Q:"Nn"[K I YSTOUT!YSUOUT Q 20 I "Yy"'[K W:K'["?" " ?",$C(7) G DI 21 S DIK="^YTD(601.4,YSDFN,1,",DA(1)=YSDFN D ^DIK W ?40,"DELETED!" Q 22 C ; 23 G:'$D(^YTD(601.2,YSDFN,1,0)) E W !!,"Completed Tests and Interviews" 24 S T=0 25 F S T=$O(^YTD(601.2,YSDFN,1,T)) G:'T!YSUOUT END F D=0:0 S D=$O(^YTD(601.2,YSDFN,1,T,1,D)) Q:'D S T(0)=T(0)+1 Q:YSTOUT!YSUOUT Q:'$D(^YTT(601,T)) W !!,$P(^YTT(601,T,0),U),?10,$$FMTE^XLFDT(D,"5ZD") D DC 26 DC ; 27 R " ...Delete? N// ",K:DTIME S YSTOUT='$T,YSUOUT=K["^",K=$E(K) Q:"Nn"[K I YSTOUT!YSUOUT Q 28 I "Yy"'[K W:K'["?" " ?",$C(7) G DC 29 S DIK="^YTD(601.2,YSDFN,1,T,1,",DA=D,DA(1)=T,DA(2)=YSDFN D ^DIK W ?40,"DELETED" Q 30 E ; 31 W:'T(0) !!,"NO TESTS/INTERVIEWS FOUND!" 32 END ; 33 K %,A,D,DA,DIC,DIK,K,P,T,X,YSAGE,YSDFN,YSDOB,YSE,YSN,YSNM,YSNOKILL,YSO,YSS,YSSEX,YSSSN,YTC 34 QUIT 35 ; 36 TN(DFN,TN6014,TN601) ;Print test name... 37 ; TN6014 = IEN of ^YTD(601.4,+DFN,1,+TN6014... 38 ; TN601 = IEN of ^YTT(601,+TN601... 39 N TESTNAME,X 40 S X=$P($G(^YTT(601,+TN601,0)),U),TESTNAME=$S(X']"":"Unknown",1:X) 41 I $G(^YTD(601.4,+DFN,1,+TN6014,99))'="MMPIR" QUIT TESTNAME ;-> 42 QUIT $S(TN601=60:"MMPIR",TN601=61:"MMPR",1:"Unknown") ;-> 43 ; 1 YTKIL ;SLC/TGA-KILL TEST/INTERVIEW DATA ;4/21/92 08:50 ;03/11/94 12:49 2 ;;5.01;MENTAL HEALTH;**37**;Dec 30, 1994 3 ; 4 ; Called from the top by MENU option YSMKIL 5 ; 6 S YSO=0,YSNOKILL=1 W @IOF,!!,"Delete Patient Data" 7 W ! D ^YSLRP G:YSDFN<1 END I '$D(^YTD(601.2,YSDFN)),'$D(^YTD(601.4,YSDFN)) W !!,"NO DATA ON THIS PATIENT!" G END 8 R ; 9 R !!,"Delete All tests and interviews? N// ",A:DTIME S YSTOUT='$T,YSUOUT=A["^" G:YSTOUT!YSUOUT END S A=$TR($E(A_"N"),"yn","YN") I "YN"'[A W:A'["?" " ?",$C(7) G R 10 I "Y"[A S DIK="^YTD(601.2,",DA=YSDFN D ^DIK S DIK="^YTD(601.4,",DA=YSDFN D ^DIK W !!,"DELETED!" G END 11 S T(0)=0 G:'$O(^YTD(601.4,YSDFN,1,0)) C W !!,"Incomplete tests and Interviews",! S YTC=$O(^YTT(601,"B","CLERK",0)) 12 S T=0 13 F S T=$O(^YTD(601.4,YSDFN,1,T)) G:'T C S T(0)=T(0)+1 G:YSTOUT!YSUOUT END S X=^(T,0),P=$P(X,U),D=$P(X,U,2),DA=P S:P=YTC P=$P(X,U,6),DA=YTC W !!,$$TN(+YSDFN,+T,+P),?10,$$FMTE^XLFDT(D,"5ZD") D DI 14 DI ; 15 R " ...Delete? N// ",K:DTIME S YSTOUT='$T,YSUOUT=K["^",K=$E(K) Q:"Nn"[K I YSTOUT!YSUOUT Q 16 I "Yy"'[K W:K'["?" " ?",$C(7) G DI 17 S DIK="^YTD(601.4,YSDFN,1,",DA(1)=YSDFN D ^DIK W ?40,"DELETED!" Q 18 C ; 19 G:'$D(^YTD(601.2,YSDFN,1,0)) E W !!,"Completed Tests and Interviews" 20 S T=0 21 F S T=$O(^YTD(601.2,YSDFN,1,T)) G:'T!YSUOUT END F D=0:0 S D=$O(^YTD(601.2,YSDFN,1,T,1,D)) Q:'D S T(0)=T(0)+1 Q:YSTOUT!YSUOUT Q:'$D(^YTT(601,T)) W !!,$P(^YTT(601,T,0),U),?10,$$FMTE^XLFDT(D,"5ZD") D DC 22 DC ; 23 R " ...Delete? N// ",K:DTIME S YSTOUT='$T,YSUOUT=K["^",K=$E(K) Q:"Nn"[K I YSTOUT!YSUOUT Q 24 I "Yy"'[K W:K'["?" " ?",$C(7) G DC 25 S DIK="^YTD(601.2,YSDFN,1,T,1,",DA=D,DA(1)=T,DA(2)=YSDFN D ^DIK W ?40,"DELETED" Q 26 E ; 27 W:'T(0) !!,"NO TESTS/INTERVIEWS FOUND!" 28 END ; 29 K %,A,D,DA,DIC,DIK,K,P,T,X,YSAGE,YSDFN,YSDOB,YSE,YSN,YSNM,YSNOKILL,YSO,YSS,YSSEX,YSSSN,YTC 30 QUIT 31 ; 32 TN(DFN,TN6014,TN601) ;Print test name... 33 ; TN6014 = IEN of ^YTD(601.4,+DFN,1,+TN6014... 34 ; TN601 = IEN of ^YTT(601,+TN601... 35 N TESTNAME,X 36 S X=$P($G(^YTT(601,+TN601,0)),U),TESTNAME=$S(X']"":"Unknown",1:X) 37 I $G(^YTD(601.4,+DFN,1,+TN6014,99))'="MMPIR" QUIT TESTNAME ;-> 38 QUIT $S(TN601=60:"MMPIR",TN601=61:"MMPR",1:"Unknown") ;-> 39 ; -
WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YTMMPI2B.m
r613 r623 1 YTMMPI2B ;ALB/ASF-MMPI2 HARRIS:LINGOS,CRIT,OS ;11/4/98 16:25 2 ;;5.01;MENTAL HEALTH;**10,31**;Dec 30, 1994 3 SCOR ; 4 S (R,S)="" F J=44:1:84 D T0^YTMMPI2A S P=YSSX D LK^YTMMPI2A 5 K A,YSTVL S YSSCALE=S,YSRAW=R 6 D HL,WAIT:IOST?1"C-".E Q:YSLFT 7 D SI Q:YSLFT 8 D OS,WAIT:IOST?1"C-".E Q:YSLFT 9 D NEWSC,WAIT:IOST?1"C".E Q:YSLFT 10 ;I $D(^YTT(601,YSTEST,"S",107)) D ^YTMMPI2D,WAIT:IOST?1"C-".E Q:YSLFT 11 D CRIT,WAIT:IOST?1"C-".E Q:YSLFT D:(X(0)["X")!(X(1)["X")!(X(2)["X") OMIT,WAIT:IOST?1"C-".E Q:YSLFT D NK^YTMMPI2P Q 12 HL ;HARRIS LINGOS 13 D DTA^YTREPT W !!!?25,"Harris-Lingoes Subscales",!?10,"(to be used as an aid in interpreting the parent scale)",!!?50,"Raw Score",?65,"T Score" 14 F J=44:1:71 S YSN=$P(^YTT(601,YSTEST,"S",J,0),U,2),R=$P(YSRAW,U,J-43),S=$P(YSSCALE,U,J-43) D:YSN?.E1"1".E HLPARNT W !?3,$E($P(YSN," ",2,9),1,36)," (",$P(YSN," "),")",?50,$J(R,4),?65,$J(S,4) D:$Y+4>IOSL&(IOST?1"C-".E) WAIT Q:YSLFT 15 Q 16 HLPARNT ; 17 W:J'=44 !! W !,$S(J=44:"Depression",J=49:"Hysteria",J=54:"Psychopathic Deviate",J=59:"Paranoia",J=62:"Schizophrenia",1:"Hypomania")," Subscales",! Q 18 WAIT ; 19 I IOST'?1"C-".E D DTA^YTREPT Q 20 ; %% ANOTHER READER CALL ???? LOOK YSLFT = YSTOUT %%% 21 W $C(7) R YSLFT:DTIME S YSTOUT='$T,YSUOUT=YSLFT["^" 22 S:YSLFT["^"!'$T YSLFT=1 Q:YSLFT S Z1=1 W # Q 23 SI ; 24 D DTA^YTREPT W !!!?25,"Social Introversion Subscales",!?18,"(Ben-Porath, Hostetler, Butcher, and Graham)",!!?50,"Raw Score",?65,"T Score" 25 F J=72:1:74 S YSN=$P(^YTT(601,YSTEST,"S",J,0),U,2),R=$P(YSRAW,U,J-43),S=$P(YSSCALE,U,J-43) W !?3,$E($P(YSN," ",2,9),1,36)," (",$P(YSN," "),")",?50,$J(R,4),?65,$J(S,4) D:$Y+4>IOSL WAIT Q:YSLFT 26 Q 27 OS ;OBVIOUS SUBTLE 28 W !!!!?25,"Wiener-Harmon Subtle-Obvious Subscales",!!?50,"Raw Score",?65,"T Score" 29 F J=75:1:84 S YSN=$P(^YTT(601,YSTEST,"S",J,0),U,2),R=$P(YSRAW,U,J-43),S=$P(YSSCALE,U,J-43) W !?3,$E($P(YSN," ",2,9),1,36)," (",$P(YSN," "),")",?50,$J(R,4),?65,$J(S,4) D:$Y+4>IOSL WAIT Q:YSLFT 30 S S=$P(YSSCALE,U,32,41) W !!?3,"Total T Score Difference (Obvious-Subtle): ",$P(S,U)+$P(S,U,3)+$P(S,U,5)+$P(S,U,7)+$P(S,U,9)-$P(S,U,2)-$P(S,U,4)-$P(S,U,6)-$P(S,U,8)-$P(S,U,10) 31 Q 32 NEWSC ;scales AAS,AAP,marital,fp S,hostility 33 Q:'$D(^YTT(601,YSTEST,"S",107)) 34 W !!?25,"Additional Supplementary Scales",! 35 S (R,S)="" F J=107:1:112 D T0^YTMMPI2A S P=YSSX D LK^YTMMPI2A 36 K A,YSTVL S YSSCALE=S,YSRAW=R 37 F J=107:1:112 S YSN=$P(^YTT(601,YSTEST,"S",J,0),U,2),R=$P(YSRAW,U,J-106),S=$P(YSSCALE,U,J-106) W !?3,$E($P(YSN," ",2,9),1,36)," (",$P(YSN," "),")",?50,$J(R,4),?65,$J(S,4) D:$Y+4>IOSL WAIT Q:YSLFT 38 W !!!!,"Uniform T scores are used for HS, D, Hy, Pd, Pa, Pt, Sc, Ma, and",!,"the Content Scales; all other MMPI-2 scales use linear T scores.",!! Q 39 CRIT ;CRITICAL ITEMS 40 D DTA^YTREPT W !?25,"Critical Items",!! S N=0 F I=1:1 S N=$O(^YTT(601,YSTEST,"G",1,1,N)) Q:'N W !,^(N,0) 41 S YSCNT=0 F J=85,88,86,89,87,90 D CRIT1 Q:YSLFT 42 Q:YSLFT W !!!,YSCNT," Koss-Butcher Critical Items were endorsed." 43 S YSCNT=0 F J=91:1:100,106 D CRIT1 Q:YSLFT 44 Q:YSLFT W !!!,YSCNT," Lachar-Wrobel Critical Items were endorsed." 45 Q 46 CRIT1 ; 47 S YSN=$P(^YTT(601,YSTEST,"S",J,0),U,2),YSKY=$S($D(^YTT(601,YSTEST,"S",J,YSSX_"K")):^(YSSX_"K"),1:^YTT(601,YSTEST,"S",J,"K",1,0)) 48 I $D(^YTT(601,YSTEST,"S",J,"K",2,0)) S YSKY=YSKY_^(0) 49 S X(0)=^YTD(601.2,YSDFN,1,YSTEST,1,YSED,1),X(1)=^(2),X(2)=^(3) D:$Y+4>IOSL WAIT Q:YSLFT W !!!,YSN,! 50 F I=1:2 S YSIT=$P(YSKY,U,I) Q:YSIT'?1N.N S B=$P(YSKY,U,I+1) I $E(X(YSIT\200),YSIT#200)=B S YSCNT=YSCNT+1 D L,WAIT:$Y+4>IOSL 51 Q 52 L W !,$J(YSIT,5),". " F K=1:1 Q:'$D(^YTT(601,YSTEST,"Q",YSIT,"T",K)) W:K'=1 !?7 W ^YTT(601,YSTEST,"Q",YSIT,"T",K,0) 53 W:B'="X" " (",B,")" Q 54 OMIT ;OMITTED ITEMS 55 D DTA^YTREPT W !!!?25,"OMITTED ITEMS",!!!,"The following items were omitted by the client. It may be helpful to",!,"discuss these items with this individual to determine the reason",!,"for non-compliance with test instructions.",!!! 56 S B="X" F I=0,1,2 I X(I)["X" F J=1:1:$L(X(I)) I $E(X(I),J)="X" S YSIT=J+(200*I) D L 57 D WAIT Q 58 VV ; 59 S N=0 F S N=$O(^YTT(601,202,"S",N)) Q:'N S G=^(N,0) W !,N,?5,$P(G,U),?10,$P(G,U,2) 1 YTMMPI2B ;ALB/ASF-MMPI2 HARRIS:LINGOS,CRIT,OS ;6/19/03 14:43 2 ;;5.01;MENTAL HEALTH;**10,31,76,70**;Dec 30, 1994 3 SCOR ; 4 S (R,S)="" F J=44:1:84 D T0^YTMMPI2A S P=YSSX D LK^YTMMPI2A 5 K A,YSTVL S YSSCALE=S,YSRAW=R 6 D HL,WAIT:IOST?1"C-".E Q:YSLFT 7 D SI Q:YSLFT 8 ;D OS,WAIT:IOST?1"C-".E Q:YSLFT 9 D NEWSC,WAIT:(IOST?1"C".E)&($Y+4>IOSL) Q:YSLFT 10 D PSY5,WAIT:(IOST?1"C".E)&($Y+4>IOSL) Q:YSLFT 11 D RCCLIN,WAIT:IOST?1"C".E Q:YSLFT 12 ;I $D(^YTT(601,YSTEST,"S",107)) D ^YTMMPI2D,WAIT:IOST?1"C-".E Q:YSLFT 13 D CRIT,WAIT:IOST?1"C-".E Q:YSLFT D:(X(0)["X")!(X(1)["X")!(X(2)["X") OMIT,WAIT:IOST?1"C-".E Q:YSLFT D NK^YTMMPI2P Q 14 HL ;HARRIS LINGOS 15 D DTA^YTREPT W !!!?25,"Harris-Lingoes Subscales",!?10,"(to be used as an aid in interpreting the parent scale)",!!?50,"Raw Score",?65,"T Score" 16 F J=44:1:71 S YSN=$P(^YTT(601,YSTEST,"S",J,0),U,2),R=$P(YSRAW,U,J-43),S=$P(YSSCALE,U,J-43) D:YSN?.E1"1".E HLPARNT W !?3,$E($P(YSN," ",2,9),1,36)," (",$P(YSN," "),")",?50,$J(R,4),?65,$J(S,4) D:$Y+4>IOSL&(IOST?1"C-".E) WAIT Q:YSLFT 17 Q 18 HLPARNT ; 19 W:J'=44 !! W !,$S(J=44:"Depression",J=49:"Hysteria",J=54:"Psychopathic Deviate",J=59:"Paranoia",J=62:"Schizophrenia",1:"Hypomania")," Subscales",! Q 20 WAIT ; 21 I IOST'?1"C-".E D DTA^YTREPT Q 22 ; %% ANOTHER READER CALL ???? LOOK YSLFT = YSTOUT %%% 23 W $C(7) R YSLFT:DTIME S YSTOUT='$T,YSUOUT=YSLFT["^" 24 S:YSLFT["^"!'$T YSLFT=1 Q:YSLFT S Z1=1 W # Q 25 SI ; 26 D DTA^YTREPT W !!!?25,"Social Introversion Subscales",!?18,"(Ben-Porath, Hostetler, Butcher, and Graham)",!!?50,"Raw Score",?65,"T Score" 27 F J=72:1:74 S YSN=$P(^YTT(601,YSTEST,"S",J,0),U,2),R=$P(YSRAW,U,J-43),S=$P(YSSCALE,U,J-43) W !?3,$E($P(YSN," ",2,9),1,36)," (",$P(YSN," "),")",?50,$J(R,4),?65,$J(S,4) D:$Y+4>IOSL WAIT Q:YSLFT 28 Q 29 OS ;OBVIOUS SUBTLE 30 W !!!!?25,"Wiener-Harmon Subtle-Obvious Subscales",!!?50,"Raw Score",?65,"T Score" 31 F J=75:1:84 S YSN=$P(^YTT(601,YSTEST,"S",J,0),U,2),R=$P(YSRAW,U,J-43),S=$P(YSSCALE,U,J-43) W !?3,$E($P(YSN," ",2,9),1,36)," (",$P(YSN," "),")",?50,$J(R,4),?65,$J(S,4) D:$Y+4>IOSL WAIT Q:YSLFT 32 S S=$P(YSSCALE,U,32,41) W !!?3,"Total T Score Difference (Obvious-Subtle): ",$P(S,U)+$P(S,U,3)+$P(S,U,5)+$P(S,U,7)+$P(S,U,9)-$P(S,U,2)-$P(S,U,4)-$P(S,U,6)-$P(S,U,8)-$P(S,U,10) 33 Q 34 NEWSC ;scales AAS,AAP,marital,fp S,hostility 35 Q:'$D(^YTT(601,YSTEST,"S",107)) 36 W !!?25,"Additional Supplementary Scales",! 37 S (R,S)="" F J=107:1:112 D T0^YTMMPI2A S P=YSSX D LK^YTMMPI2A 38 K A,YSTVL S YSSCALE=S,YSRAW=R 39 F J=107:1:112 S YSN=$P(^YTT(601,YSTEST,"S",J,0),U,2),R=$P(YSRAW,U,J-106),S=$P(YSSCALE,U,J-106) W !?3,$E($P(YSN," ",2,9),1,36)," (",$P(YSN," "),")",?50,$J(R,4),?65,$J(S,4) D:$Y+4>IOSL WAIT Q:YSLFT 40 W !!,"Uniform T scores are used for HS, D, Hy, Pd, Pa, Pt, Sc, Ma, and",!,"the Content Scales; all other MMPI-2 scales use linear T scores.",! Q 41 PSY5 ; ADDED 8/30/02 ASF 42 Q:'$D(^YTT(601,YSTEST,"S",114)) 43 W !?25,"PSY-5 Personality Psychopathology Five",!?50,"Raw Score",?65,"T Score" 44 S (R,S)="" F J=114:1:118 D T0^YTMMPI2A S P=YSSX D LK^YTMMPI2A 45 K A,YSTVL S YSSCALE=S,YSRAW=R 46 F J=114:1:118 S YSN=$P(^YTT(601,YSTEST,"S",J,0),U,2),R=$P(YSRAW,U,J-113),S=$P(YSSCALE,U,J-113) W !?3,YSN,?50,$J(R,4),?65,$J(S,4) D:$Y+4>IOSL WAIT Q:YSLFT 47 Q 48 RCCLIN ;restructured clinical 49 Q:$G(^YTT(601,YSTEST,"S",119,0))'?.E1"RC".E 50 W !!?25,"RC Restructured Clinical Scales",!?50,"Raw Score",?65,"T Score" 51 S (R,S)="" F J=119:1:127 D T0^YTMMPI2A S P=YSSX D LK^YTMMPI2A 52 K A,YSTVL S YSSCALE=S,YSRAW=R 53 F J=119:1:127 S YSN=$P(^YTT(601,YSTEST,"S",J,0),U,2),R=$P(YSRAW,U,J-118),S=$P(YSSCALE,U,J-118) W !?3,YSN,?50,$J(R,4),?65,$J(S,4) D:$Y+4>IOSL WAIT Q:YSLFT 54 Q 55 CRIT ;CRITICAL ITEMS 56 D DTA^YTREPT W !?25,"Critical Items",!! S N=0 F I=1:1 S N=$O(^YTT(601,YSTEST,"G",1,1,N)) Q:'N W !,^(N,0) 57 S YSCNT=0 F J=85,88,86,89,87,90 D CRIT1 Q:YSLFT 58 Q:YSLFT W !!!,YSCNT," Koss-Butcher Critical Items were endorsed." 59 S YSCNT=0 F J=91:1:100,106 D CRIT1 Q:YSLFT 60 Q:YSLFT W !!!,YSCNT," Lachar-Wrobel Critical Items were endorsed." 61 Q 62 CRIT1 ; 63 S YSN=$P(^YTT(601,YSTEST,"S",J,0),U,2),YSKY=$S($D(^YTT(601,YSTEST,"S",J,YSSX_"K")):^(YSSX_"K"),1:^YTT(601,YSTEST,"S",J,"K",1,0)) 64 I $D(^YTT(601,YSTEST,"S",J,"K",2,0)) S YSKY=YSKY_^(0) 65 S X(0)=^YTD(601.2,YSDFN,1,YSTEST,1,YSED,1),X(1)=^(2),X(2)=^(3) D:$Y+4>IOSL WAIT Q:YSLFT W !!!,YSN,! 66 F I=1:2 S YSIT=$P(YSKY,U,I) Q:YSIT'?1N.N S B=$P(YSKY,U,I+1) I $E(X(YSIT\200),YSIT#200)=B S YSCNT=YSCNT+1 D L,WAIT:$Y+4>IOSL 67 Q 68 L W !,$J(YSIT,5),". " F K=1:1 Q:'$D(^YTT(601,YSTEST,"Q",YSIT,"T",K)) W:K'=1 !?7 W ^YTT(601,YSTEST,"Q",YSIT,"T",K,0) 69 W:B'="X" " (",B,")" Q 70 OMIT ;OMITTED ITEMS 71 D DTA^YTREPT W !!!?25,"OMITTED ITEMS",!!!,"The following items were omitted by the client. It may be helpful to",!,"discuss these items with this individual to determine the reason",!,"for non-compliance with test instructions.",!!! 72 S B="X" F I=0,1,2 I X(I)["X" F J=1:1:$L(X(I)) I $E(X(I),J)="X" S YSIT=J+(200*I) D L 73 D WAIT Q 74 VV ; 75 S N=0 F S N=$O(^YTT(601,202,"S",N)) Q:'N S G=^(N,0) W !,N,?5,$P(G,U),?10,$P(G,U,2) -
WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YTPCL.m
r613 r623 1 YTPCL ;ALB/ASF TEST-PTST CHECKLISTS ; 4/5/07 10:05am 2 ;;5.01;MENTAL HEALTH;**66,85**;Dec 30, 1994;Build 49 3 ; 4 ;Reference to ^DIR supported by IA #10026 5 ; 6 SCOR ; 7 S YSTY="W*",YSNOITEM="DONE^YTPCL" 8 D ^YTREPT 9 S X=^YTD(601.2,YSDFN,1,YSET,1,YSED,1) 10 S (B,C,D)=0 11 F I=1:1:5 S Y=$E(X,I) S:(Y=3)!(Y=4)!(Y=5) B=B+1 12 F I=6:1:12 S Y=$E(X,I) S:(Y=3)!(Y=4)!(Y=5) C=C+1 13 F I=13:1:17 S Y=$E(X,I) S:(Y=3)!(Y=4)!(Y=5) D=D+1 14 ZZ W !!,"DSM-IV PTSD Criteria B ",$S(B>0:"IS met",1:"is NOT met") 15 W !,"DSM-IV PTSD Criteria C ",$S(C>2:"IS met",1:"is NOT met") 16 W !,"DSM-IV PTSD Criteria D ",$S(D>1:"IS met",1:"is NOT met") 17 I (B>0)&(C>2)&(D>1) W !!,"*** PTSD Diagnosis IS SUGGESTED ***" 18 W !! 19 I IOST?1"C".E W ! S DIR(0)="E" D ^DIR Q:Y'=1 20 W !!!,"Items" 21 F I=1:1:17 D 22 . W !,I,". ",^YTT(601,YSET,"Q",I,"T",1,0) 23 . I $D(^YTT(601,YSET,"Q",I,"T",2,0)) W:^(0)'=" " !?7,^(0) 24 . I I=5 W !?7,^YTT(601,YSET,"Q",I,"T",3,0) 25 . W " :",$E(^YTD(601.2,YSDFN,1,YSET,1,YSED,1),I) 26 W !!,"1= Not at all 2= A little bit 3= Moderately 4= Quite a bit 5= Extremely" 27 Q 28 SPTSD ;SCREENING REPORT 29 D DTA^YTREPT 30 W !!,?7,"Post Traumatic Stress Disorder Screen",!! 31 S X=^YTD(601.2,YSDFN,1,YSET,1,YSED,1) 32 W !,"Patient Reports "_$S($E(X,1)="Y":"HAVING",1:"NO")_" traumatic experiences.",! 33 W:$E(X,2)="Y" !,"In the past month, the patient has been bothered by repeated, disturbing",!,"memories, thoughts, or images of one or more of the stressful events." 34 W:$E(X,3)="Y" !,"In the past month, has felt distant or cut off from other people." 35 W:$E(X,4)="Y" !,"Has been 'super alert' or watchful or on guard in the past month." 36 W:$E(X,2,9)?.E1"Y".E !!,"Please refer to a mental health professional for further evaluation",!,"and treatment of probable PTSD" 37 I IOST?1"C".E W ! S DIR(0)="E" D ^DIR Q:Y'=1 38 DONE QUIT 1 YTPCL ;ALB/ASF TEST-PTST CHECKLISTS ;7/19/00 11:11 2 ;;5.01;MENTAL HEALTH;**66**;Dec 30, 1994 3 ; 4 ;Reference to ^DIR supported by IA #10026 5 ; 6 SCOR ; 7 S YSTY="W*",YSNOITEM="DONE^YTPCL" 8 D ^YTREPT 9 S X=^YTD(601.2,YSDFN,1,YSET,1,YSED,1) 10 S (B,C,D)=0 11 F I=1:1:5 S Y=$E(X,I) S:(Y=3)!(Y=4)!(Y=5) B=B+1 12 F I=6:1:12 S Y=$E(X,I) S:(Y=3)!(Y=4)!(Y=5) C=C+1 13 F I=13:1:17 S Y=$E(X,I) S:(Y=3)!(Y=4)!(Y=5) D=D+1 14 ZZ W !!,"DSM-IV PTSD Criteria B ",$S(B>0:"IS met",1:"is NOT met") 15 W !,"DSM-IV PTSD Criteria C ",$S(C>2:"IS met",1:"is NOT met") 16 W !,"DSM-IV PTSD Criteria D ",$S(D>1:"IS met",1:"is NOT met") 17 I (B>0)&(C>2)&(D>1) W !!,"*** PTSD Diagnosis IS SUGGESTED ***" 18 W !! 19 I IOST?1"C".E W ! S DIR(0)="E" D ^DIR Q:Y'=1 20 D IR^YTREPT 21 Q 22 SPTSD ;SCREENING REPORT 23 D DTA^YTREPT 24 W !!,?7,"Post Traumatic Stress Disorder Screen",!! 25 S X=^YTD(601.2,YSDFN,1,YSET,1,YSED,1) 26 W !,"Patient Reports "_$S($E(X,1)="Y":"HAVING",1:"NO")_" traumatic experiences.",! 27 W:$E(X,2)="Y" !,"In the past month, the patient has been bothered by repeated, disturbing",!,"memories, thoughts, or images of one or more of the stressful events." 28 W:$E(X,3)="Y" !,"In the past month, has felt distant or cut off from other people." 29 W:$E(X,4)="Y" !,"Has been 'super alert' or watchful or on guard in the past month." 30 W:$E(X,2,9)?.E1"Y".E !!,"Please refer to a mental health professional for further evaluation",!,"and treatment of probable PTSD" 31 I IOST?1"C".E W ! S DIR(0)="E" D ^DIR Q:Y'=1 32 DONE QUIT
Note:
See TracChangeset
for help on using the changeset viewer.
