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