Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SCCVCST3

SCCVCST3.m

Go to the documentation of this file. 
  1. SCCVCST3 ;ALB/TMP - Scheduling Conversion Template Utilities - CST; APR 20, 1998
  1.  ;;5.3;Scheduling;**211,1015**;Aug 13, 1993;Build 21
  1.  ;
  1. ONE ; -- Select/Convert one pt's encounter episode - no CST needed
  1.  D FULL^VALM1
  1.  ; -- is conversion enabled
  1.  IF '$$OK^SCCVU(1) G ONEQ
  1.  ;
  1.  F  W !! Q:$$SEL1()
  1.  ;
  1. ONEQ S VALMBCK="R"
  1.  Q
  1.  ;
  1. SEL1() ; Select an entry, convert
  1.  N DIR,X,Y,SCFILE,SCFILE1,SCCVDFN,SCCVTYP,SCCVDA,SCCVCOD,SCQUIT,DA,DIC,DIQ,SCSTOP,SCCVEVT,SCPREF,Z,SCCVACRP,SCCV900,SCCVDIS
  1.  S SCCVACRP=$$ENDDATE^SCCVU()
  1.  S SCCV900=+$O(^DIC(40.7,"C",900,0))
  1.  S SCSTOP=0
  1.  S DIR(0)="SAMB^C:Convert;R:Reconvert",DIR("A")="(C)onvert/(R)econvert: ",DIR("B")="Convert"
  1.  D ^DIR K DIR
  1.  I Y["^" S SCSTOP=1 G SEL1Q
  1.  S SCCVEVT=$S(Y="C":1,1:2),SCPREF=$S(SCCVEVT=1:"",1:"re")
  1.  ;
  1.  S DIR(0)="SABM^E:Encounter;D:Disposition;A:Appointment;S:Standalone Add/Edit",SCCVCOD=$P(DIR(0),U,2)
  1.  S DIR("A")="TYPE OF ENTRY TO "_$S(SCCVEVT=1:"",1:"RE")_"CONVERT: ",DIR("?")="Select the type of entry you want to "_SCPREF_"convert from the list"
  1.  D ^DIR K DIR
  1.  I "EDAS"'[Y S SCSTOP=1 G SEL1Q
  1.  S SCCVTYP=Y,SCCVTYPN=$P($P(SCCVCOD,SCCVTYP_":",2),";")
  1.  ;
  1.  S DIC="^DPT(",DIC(0)="AEMQ" D ^DIC ;Select patient
  1.  G:Y'>0 SEL1Q
  1.  S SCCVDFN=+Y
  1.  ;
  1.  S SCFILE=$$SETFL($S(SCCVTYP="E":0,SCCVTYP="D":3,SCCVTYP="A":1,1:2),SCCVDFN)
  1.  S SCFILE1=$S(SCFILE["SCE"!(SCFILE["SDV"):SCFILE_"("_$S(SCFILE["SCE":"""ADFN"","_SCCVDFN_",",1:""),1:$P(SCFILE,")")_",") ;Indirection format
  1.  ;
  1.  ; Select a specific entry
  1.  S SCQUIT=0
  1.  W !
  1.  S DIR(0)=$S(SCFILE["SCE":"NAO^^I $P($G(^SCE(X,0)),U,2)'=SCCVDFN K X",SCFILE["SDV":"FAO^^D DTCNVT^SCCVCST3(.X)",1:"DAO^:"_SCCVACRP_":RXP")
  1.  S DIR("A")="ENTER THE "_$S(SCFILE["SDV":"SCHEDULING VISIT ENTRY #",SCFILE["SCE":"ENCOUNTER ENTRY #",SCFILE["""DIS""":"DISPOSITION DATE/TIME",1:"APPOINTMENT DATE/TIME")_", IF KNOWN: "
  1.  S DIR("?",1)="Enter the "_$S(SCFILE["SCE":"internal entry number",1:"date/time")_" of the "_SCCVTYPN_" to "_SCPREF_"convert, if you know it"
  1.  S Z=2
  1.  I SCFILE["SDV" S DIR("?",2)="Date may be entered in internal or external format",Z=Z+1
  1.  S DIR("?",Z)="Must be a valid "_SCCVTYPN_$S(SCFILE'["SCE":" date/time",1:"")_" for the patient"_$S(SCFILE'["SCE":", on or before "_$$FMTE^XLFDT(SCCVACRP,"1D"),1:"")
  1.  S DIR("?")="If not known, Press RETURN to review the "_SCCVTYPN_"s on a specific date"
  1.  D ^DIR K DIR
  1.  W !!
  1.  ;
  1.  S SCCVDA=$S(Y'>0:0,SCFILE'["""DIS""":+Y,1:9999999-Y)
  1.  I SCCVDA D CHK(SCCVEVT,SCCVTYPN,SCFILE,SCFILE1,$S(SCFILE'["SCE":+Y,1:+$G(^SCE(SCCVDA,0))),SCCVDA,0,.SCQUIT,.SCONE) ;Specific entry selected
  1.  ;
  1.  G:SCQUIT SEL1Q
  1.  ;
  1.  ; Select entry by date or date/time
  1.  S DIR(0)="DAO^:"_SCCVACRP_":PTSX"
  1.  S DIR("A")="DATE: "
  1.  S DIR("?",1)="Enter a valid date or date and time of the patient's "_SCCVTYPN_" to "_SCPREF_"convert."
  1.  S DIR("?",2)=" The date must be on or before "_$$FMTE^XLFDT(SCCVACRP,1)_".",DIR("?",3)=" "
  1.  S DIR("?",4)="If you enter only a date, all the patient's "_SCCVTYPN_"s on that date will be",DIR("?",5)=" presented one at a time.  If the entry displayed is the correct one,"
  1.  S DIR("?")=" you may request it be "_SCPREF_"converted or if not the correct one, reject it."
  1.  D ^DIR K DIR
  1.  G:'Y SEL1Q
  1.  S SCDTM=+Y,SCQUIT=0
  1.  ;
  1.  I SCDTM'["." D  G:SCQUIT SEL1Q ; Date only entered
  1.  . ; SCQUIT is set to 1 when an entry is selected for conversion
  1.  . ; SCONE is set to 1 if at least one valid entry is found
  1.  . ;
  1.  . N SCONE,SC,SCV,SCF,SCD
  1.  . S SCF=$S(SCFILE["SCE":"^SCE(""ADFN"","_SCCVDFN_")",SCFILE["SDV":"^SDV(""ADT"","_SCCVDFN_")",1:SCFILE)
  1.  . S SCONE=$S(SCF["SCE":$O(@SCF@(SCDTM)),SCF["""S""":$O(@SCF@(SCDTM)),SCF["""DIS""":9999999-$O(@SCF@(9999999-SCDTM),-1),1:$O(@SCF@(SCDTM-1)))
  1.  . S SCONE=(SCONE\1=SCDTM)
  1.  . I '$G(SCONE) D NOENT^SCCVCST4(SCCVTYPN,SCCVDFN,SCDTM) S SCQUIT=1 Q  ;No valid entry found
  1.  . I SCCVEVT=2 S SCONE=0
  1.  . ;
  1.  . I SCFILE["SCE"!(SCFILE["""S""") D  ; Encounters and Appts
  1.  .. S SC=SCDTM,SCONE=0
  1.  .. F  S SC=$O(@SCF@(SC)) Q:'SC!((SC\1)'=SCDTM)  D  Q:SCQUIT
  1.  ... I SCF["SCE" D  ; Encounters
  1.  .... S SCD=0 F  S SCD=$O(@SCF@(SC,SCD)) Q:'SCD  W "." I '$P($G(^SCE(SCD,0)),U,6) D CHK(SCCVEVT,SCCVTYPN,SCFILE,SCFILE1,+$G(^SCE(SCD,0)),SCD,1,.SCQUIT,.SCONE) Q:SCQUIT
  1.  ... ;
  1.  ... I SCF["""S""" D  ; Appts
  1.  .... D CHK(SCCVEVT,SCCVTYPN,SCFILE,SCFILE1,SC,SC,1,.SCQUIT,.SCONE)
  1.  . ;
  1.  . I SCFILE["""DIS""" D  ; Dispositions
  1.  .. S SCDTM=9999999-SCDTM-1,SC=SCDTM+1,SCONE=0
  1.  .. F  S SC=$O(@SCF@(SC),-1) Q:'SC!((SC\1)'=SCDTM)  W "." D  Q:SCQUIT
  1.  ... D CHK(SCCVEVT,SCCVTYPN,SCFILE,SCFILE1,9999999-SC,SC,1,.SCQUIT,.SCONE)
  1.  . I SCFILE["SDV" D  ; Add/edits
  1.  .. S SCONE=0,SC=$G(@SCF@(SCDTM))
  1.  .. Q:SC=""
  1.  .. D CHK(SCCVEVT,SCCVTYPN,SCFILE,SCFILE1,SC,SC,1,.SCQUIT,.SCONE)
  1.  . ;
  1.  . I 'SCONE S SCQUIT=1 D NOENT^SCCVCST4(SCCVTYPN,SCCVDFN,SCDTM) Q
  1.  . ;
  1.  . I 'SCQUIT,SCONE S DIR(0)="EA",DIR("A",1)="NO ENTRY SELECTED",DIR("A")="PRESS RETURN " D ^DIR K DIR
  1.  ;
  1.  I SCDTM["." D  ; Date and time entered
  1.  . I SCFILE["SCE" D  ; Encounter
  1.  .. S SCCVDA=0 F  S SCCVDA=$O(^SCE("ADFN",SCCVDFN,SCDTM,SCCVDA)) W "." Q:'SCCVDA  D
  1.  ... D CHK(SCCVEVT,SCCVTYPN,SCFILE,SCFILE1,SCDTM,SCCVDA,1,.SCQUIT,.SCONE)
  1.  . ;
  1.  . I SCFILE'["SCE" D  ; Non-encounter
  1.  .. S SCCVDA=$S(SCFILE'["""DIS""":SCDTM,1:9999999-SCDTM)
  1.  .. D CHK(SCCVEVT,SCCVTYPN,SCFILE,SCFILE1,SCDTM,SCCVDA,0,.SCQUIT,.SCONE)
  1. SEL1Q Q SCSTOP
  1.  ;
  1. SETFL(SCCVTYP,SCCVDFN) ;Set the lookup format of the file
  1.  ; INPUT: SCCVTYP, SCCVDFN
  1.  ; FUNCTION OUTPUT: Lookup format of filename for type/patient
  1.  ;
  1.  Q $S(SCCVTYP=0:"^SCE",SCCVTYP=3:"^DPT("_SCCVDFN_",""DIS"")",SCCVTYP=1:"^DPT("_SCCVDFN_",""S"")",SCCVTYP=2:"^SDV",1:"")
  1.  ;
  1. CHK(SCCVEVT,SCCVTYPN,SCFILE,SCFILE1,SCDTM,SC,SCMULT,SCQUIT,SCONE) ;
  1.  ; Check for validity for convert, display entry, convert if confirmed
  1.  N SCV,DIR,Y
  1.  I $$VAL1^SCCVCST5(SCCVEVT,SCFILE,SC,SCMULT) D
  1.  .S SCONE=1
  1.  .W ! S SCV=$$DISP1^SCCVCST4(SCCVTYPN,SCFILE1,SC)
  1.  .I 'SCV S:SCV="^" SCQUIT=1 Q
  1.  .S SCQUIT=1 D CONV1^SCCVCST4(SCCVEVT,SCFILE,SCCVDFN,SCDTM,SC)
  1.  Q
  1.  ;
  1. DTCNVT(X) ; Convert date/time for disposition
  1.  N SCZ,SCX,Y,Z,%DT
  1.  S %DT="RXPT"
  1.  I X["@"!(X'[".") D
  1.  . S SCX=$P(X,"@",2)
  1.  . S SCZ=$TR(SCX,"APMapm"),Z=$L(SCZ) ;strip AM/PM from time
  1.  . I Z>4 S %DT=%DT_"S" S:Z=5 X=$P(X,"@")_"@"_SCZ_"0"
  1.  D ^%DT S X=Y
  1.  K:Y<0 X
  1.  Q
  1.  ;